Question

我无法找到错误：我想要做的是使这个代码仅在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

Answer 1

当您在未指定工作表的情况下访问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

如何为特定的Excel文件运行VBA代码？

1 个答案: