1

我无法找到错误：我想要做的是让此代码仅在 Book1.xls 的 Sheet1 上运行，即使我在其他 excel 文件或该文件的其他工作表中工作。代码的第一部分一切正常，直到** -line 但之后当我在不同的页面上或将其归档时“阻塞”并给我一个错误。

    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 回答