excel - VBA 宏循环遍历多个工作表并返回完全匹配

Question

我已经浏览了互联网上的相关主题，但是我找不到解决我遇到的问题的方法。我正在研究一个宏，它将一个工作簿中的相关数据复制到另一个工作簿中新创建的工作表中，然后遍历后者的剩余工作表，以找到与这个新创建工作表中的数据完全匹配的数据。我复制和粘贴数据的部分工作正常，但是，在循环工作表时会发生错误。

我研究了这个宏的多个版本，以查看不同的解决方案是否可行，但实际上似乎没有一个可行。在目标工作簿中，工作表在 A 列中包含数据代码(某种 id)，在 B 列中包含数据相关性的度量，在 C 列中包含变量名称。

我要做的是，在将数据复制并粘贴到新创建的工作表后 - 数据代码包含在 L 列中，循环遍历目标工作簿中的所有默认工作表，以检查 L 列中的代码是否新创建的工作表与剩余工作表的 A 列中的代码重叠，如果是，则将相关工作表的 C 列中的变量名称复制到新创建的工作表列 M 中。新创建的工作表称为“设置”并包含第 1 行的标题(它也包含大约 110 行)，其余工作表不包含标题(最多 70 行)。

宏如下所示:

Sub match1()

    Dim listwb As Workbook, mainwb As Workbook
    Dim FolderPath As String
    Dim fname As String
    Dim sht As Worksheet
    Dim ws As Worksheet, oput As Worksheet
    Dim oldRow As Integer
    Dim Rng As Range
    Dim ws2Row As Long

    Set mainwb = Application.ThisWorkbook
    With mainwb
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Settings"
        Set oput = Sheets("Settings")
    End With

    FolderPath = "C:\VBA\"

    fname = Dir(FolderPath & "spr.xlsx")


    With Application
        Set listwb = .Workbooks.Open(FolderPath & fname)
    End With

    Set sht = listwb.Worksheets(1)

    With sht
        .UsedRange.Copy
    End With

    mainwb.Activate

            With oput
                .Range("A1").PasteSpecial
            End With

            For Each ws In ActiveWorkbook.Worksheets
                If ws.Name <> "Settings" Then
                    ws2Row = ws.Range("A" & Rows.Count).End(xlUp).Row
                    Set Rng = ws.Range("A:C" & ws2Row)
                    For oldRow = 2 To 110
                        Worksheets("Settings").Cells(oldRow, 13) = Application.WorksheetFunction.IfError(Application.WorksheetFunction.VLookup(Worksheets("Settings").Cells(oldRow, 12), Rng, 3, False), "")
                    Next oldRow
                End If
            Next ws

End Sub

替代版本如下所示(跳过复制粘贴部分):

 mainwb.Activate

        With oput
            .Range("A1").PasteSpecial
        End With

        For Each ws In ActiveWorkbook.Worksheets
            If ws.Name <> "Settings" Then
                i = 1
                For oldRow = 2 To 110
                    For newRow = 1 To 70
                        If StrComp((Worksheets("Settings").Cells(oldRow, 12).Text), (ws.Cells(newRow, 1).Text), vbTextCompare) <> 0 Then
                            i = oldRow
                            Worksheets("Settings").Cells(i, 13) = " "
                            Else
                            Worksheets("Settings").Cells(i, 13) = ws.Cells(newRow, 3)
                            i = i + 1
                            Exit For
                        End If
                    Next newRow
                Next oldRow
            End If
        Next ws

当我启动宏的第一个版本时，出现错误:

Run-time error '1004':

Method 'Range' of object '_Worksheet' failed

调试突出显示部分:

Set Rng = ws.Range("A:C" & ws2Row)

当我运行宏的第二个版本时，错误消息显示:

Run-time error '9':

Subscript out of range

调试突出显示部分:

If StrComp((Worksheets("Settings").Cells(oldRow, 12).Text), (ws.Cells(newRow, 1).Text), vbTextCompare) <> 0 Then

我怀疑问题出在 ws (Worksheet) 对象的定义和使用上。我现在很困惑，因为我经常使用 VBA，而且我完成的任务比这个更难。然而我仍然无法解决问题。您能否提出一些解决方案。我会感谢你的帮助。

Answer 1

在这一行:Set Rng = ws.Range("A:C" & ws2Row)您没有为列 A 指定行值.您的代码基本上是 Range("A:C110") ，这对 Excel 没有任何意义。尝试将其更改为 Range("A2:C" & ws2Row) .

这能解决问题吗？