Question

我正在尝试从具有不同工作表名称的多个工作簿中提取数据。我创建了一个包含所有可能的工作表名称的数组。当数据工作簿打开并且找不到工作表名称时，错误处理程序第一次工作时，循环再次运行并拉下一个数组元素，错误处理程序不起作用。它给出“下标超出范围”错误。任何人都可以详细说明我在这里缺少什么？我想要的是，如果数据工作簿中没有连续的工作表名称，代码应该再次进入循环并搜索下一个工作表名称。

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim i As Integer
    Dim VendorValue As String
    Dim SheetNames() As Variant
    Dim a As String

    strListSheet = "Master"

    Sheets(strListSheet).Select
    Range("First_file").Select
    SheetNames = Range("Sheet_Names")

    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""

        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        VendorValue = ActiveCell.Offset(0, 2)
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook

        For i = LBound(SheetNames, 1) To UBound(SheetNames, 1)
        a = SheetNames(i, 1)
        b = SheetNames(i, 2)

        dataWB.Activate
        On Error GoTo Handler:
        ActiveWorkbook.Sheets(a).Select

        Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Select
        Selection.Copy

        currentWB.Activate
        Sheets(VendorValue).Select
        Range(b).Select

        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False

Handler:
        Next  
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select

    Loop

    Exit Sub
End Sub

Answer 1

您必须退出错误处理程序才能重用它。也就是说，在错误处理程序的末尾需要一个Resume子句。

查看此site了解详情。

我已经在sub的末尾移动了处理程序并添加了Resume。

Public strFileName As String
Public currentWB As Workbook
Public dataWB As Workbook

Sub GetData()
    Dim strListSheet As String
    Dim i As Integer
    Dim VendorValue As String
    Dim SheetNames() As Variant
    Dim a As String

    strListSheet = "Master"

    Sheets(strListSheet).Select
    Range("First_file").Select
    SheetNames = Range("Sheet_Names")

    'this is the main loop, we will open the files one by one and copy their data into the masterdata sheet
    Set currentWB = ActiveWorkbook
    Do While ActiveCell.Value <> ""

        strFileName = ActiveCell.Offset(0, 1) & ActiveCell.Value
        VendorValue = ActiveCell.Offset(0, 2)
        Application.Workbooks.Open strFileName, UpdateLinks:=False, ReadOnly:=True
        Set dataWB = ActiveWorkbook

        For i = LBound(SheetNames, 1) To UBound(SheetNames, 1)
        a = SheetNames(i, 1)
        b = SheetNames(i, 2)

        dataWB.Activate
        On Error GoTo Handler:
        ActiveWorkbook.Sheets(a).Select

        Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Select
        Selection.Copy

        currentWB.Activate
        Sheets(VendorValue).Select
        Range(b).Select

        Selection.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False

Handler2:
        Next  
        dataWB.Close False
        Sheets(strListSheet).Select
        ActiveCell.Offset(1, 0).Select

    Loop

    Exit Sub
Handler:
    Resume Handler2
End Sub

Answer 2

如果您的所有文件都在同一条路径中，我认为使用它更容易：

Sub openOtherWorkbooks()

    Dim folderPath As String, path As String

    folderPath = "C:\Path\to\your\files"

    path = folderPath & "\*.xlsm"        'xlsm as an example - could be xls* as well

    Do While Filename <> ""

        Filename = Dir()

        If Filename <> ThisWorkbook.Name And Filename <> "" Then

            Workbooks.Open folderPath & "\" & Filename

            For i = 1 To Workbooks(Filename).Sheets.count

                ' do everything with every sheet of this file

            Next i

            Workbooks(Filename).Close False

        End If

        Filename = Dir(path)

    Loop

End Sub

它只是打开每个文件，计算打开文件的表格（以 1 开头）然后应该有你的代码。

这并不是你的On-Error-GoTo-thing与你的处理程序的答案。

Answer 3

我改变方法如下：

Dim mySht as Worksheet 

a = SheetNames(i, 1)
Set mySht = GetSheet(dataWB, a)
If Not mySht Is Nothing Then
   b = SheetNames(i, 2)
   With mySht
      .Range("H5:H120,I5:I120,M5:M120,P5:P120,U5:X120").Copy
      currentWB.Sheets(VendorValue).Range(b).PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        Application.CutCopyMode = False
   End With  
End If

我只显示从a和b设置（包含）到Handler标签的部分（包括在内，即必须消失）。

您必须将此代码放在任何模块中（也在Sub的末尾）：

Function GetSheet(wb as Workbook, shtName as String)
   On Error Resume Next
   Set GetSheet = wb.Worksheet(shtName)
End Function

最后，您的其余代码可以以类似的方式避免大量激活/激活/选择/选择内容

错误处理程序在vba中只能运行一次

3 个答案: