1

エラーを見つけるのに問題があります。他のExcelファイルまたはこのファイルの他のシートで作業している場合でも、このコードをBook1.xlsのSheet1でのみ実行するようにします。**行まではコードの最初の部分ですべて正常に機能しますが、その後、別のページまたはファイルに移動すると、「チョーク」してエラーが発生します。

    Sub Upload0()

' Upload Webpage content
Application.OnTime Now + TimeValue("00:00:10"), "Upload0"
With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _
    "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1"))
    .Name = "CetatenieOrdine"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
  End With

' Deletes Empty Cells
Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

******************************************************************************

' Deletes useless Rows and fits the Width
Rows("1:31").Select
Selection.Delete Shift:=xlUp
Range("B28").Select
Selection.End(xlDown).Select
Rows("17:309").Select
Selection.Delete Shift:=xlUp


' Text to Column function with auto-confirmation to overwrite
Columns("A:A").Select
Application.DisplayAlerts = False
Selection.TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
    :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = True

Columns("B:B").Select
Application.DisplayAlerts = False
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
    Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
    :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
    TrailingMinusNumbers:=True
Application.DisplayAlerts = True
Columns("B:B").Select
Selection.Delete Shift:=xlToLeft


' fit the Width of All Columns
Cells.Select
Range("A37").Activate
Cells.EntireColumn.AutoFit
Range("H1").Select
Rows("1:1").Select
Selection.Font.bold = True

End Sub
4

1 に答える 1

4

シートにアクセスする場合、RowsまたはRangeシートを指定しない場合、VBAはActiveSheetを使用します。この場合、操作するシートを明示的に指定する必要があります。

Sub Upload0()

' Upload Webpage content
Application.OnTime Now + TimeValue("00:00:10"), "Upload0"
With Workbooks("Book1.xls").Sheets("Sheet1").QueryTables.Add(Connection:= _
    "URL;http://cetatenie.just.ro/ordine/articol-11", Destination:=Workbooks("Book1.xls").Sheets("Sheet1").Range("A1"))
    .Name = "CetatenieOrdine"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = True
    .BackgroundQuery = True
    .RefreshStyle = xlOverwriteCells
    .SavePassword = True
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlEntirePage
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
  End With

' Deletes Empty Cells
Workbooks("Book1.xls").Sheets("Sheet1").Range("A1").Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

******************************************************************************
With Workbooks("Book1.xls").Sheets("Sheet1")
    ' Deletes useless Rows and fits the Width
    .Rows("1:31").Delete Shift:=xlUp
    .Rows("17:309").Delete Shift:=xlUp


    ' Text to Column function with auto-confirmation to overwrite
    Application.DisplayAlerts = False
    .Columns("A:A").TextToColumns Destination:=Columns("A:A"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
            :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True
    .Columns("B:B").TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=True, Other:=False, OtherChar _
            :=":", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
            TrailingMinusNumbers:=True
    Application.DisplayAlerts = True
    .Columns("B:B").Delete Shift:=xlToLeft


    ' fit the Width of All Columns
    .Cells.EntireColumn.AutoFit
    .Rows("1:1").Font.bold = True
End With

End Sub
于 2013-03-27T10:47:19.703 に答える