VBA宏循環遍歷多個工作表並返回完全匹配項

Question

我已經遍歷了Internet上的相關主題，但是找不到解決所遇到問題的解決方案。 我正在處理一個宏，該宏會將一個工作簿中的相關數據復制到另一個工作簿中新創建的工作表中，然后循環瀏覽后者的其余工作表，以查找與此新創建工作表中的數據完全匹配的內容。 我復制和粘貼數據的部分工作正常，但是，在循環工作表時會發生錯誤。

我設計了此宏的多個版本，以查看不同的解決方案是否可行，但實際上似乎沒有一個可行。 在目標工作簿中，工作表在A列中包含數據行情顯示（一種ID），在B列中包含數據相關性度量，在C列中包含變量名稱。

我想做的是，在將數據復制並粘貼到新創建的工作表之后（數據行情包含在L列中），循環遍歷目標工作簿中的所有默認工作表，以檢查是否存在新創建的工作表與restig工作表的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

當我啟動宏的第一個版本時，出現錯誤：

運行時錯誤“ 1004”：

對象“ _Worksheet”的方法“范圍”失敗

調試突出顯示了以下部分：

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

當我運行宏的第二個版本時，錯誤消息顯示為：

運行時錯誤“ 9”：

下標超出范圍

調試突出顯示了以下部分：

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

我懷疑問題在於ws（工作表）對象的定義和使用。 我現在很困惑，因為我經常使用VBA，而且我完成的任務比這個要難得多。 但是我仍然無法解決問題。 您能否提出一些解決方案。 感謝您的幫助。

Answer 1

在這一行： Set Rng = ws.Range("A:C" & ws2Row)您不會為Column A指示行值。 您的代碼基本上說的是Range("A:C110") ，對Excel而言實際上沒有任何意義。 嘗試將其更改為Range("A2:C" & ws2Row) 。

這樣可以解決問題嗎？