Question

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

我编写了这个宏的多个版本，看看不同的解决方案是否可行，但实际上似乎都没有。我是目标工作簿，工作表包含A列中的数据代码（类型ID），B列中数据相关性的度量以及C列中变量的名称。

我要做的是，在将数据复制并粘贴到新创建的工作表之后 - 数据代码包含在L列中，循环遍历目标工作簿中的所有默认工作表以检查列中的代码新创建的工作表中的L与剩余工作表的A列中的代码重叠，如果是，则将变量名称从相关工作表的C列复制到新创建的工作表列M.新创建的工作表称为＆＃ 34;设置＆＃34;并包含第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

当我启动宏的第一个版本时，我收到一个错误：

运行时错误＆＃39; 1004＆＃39;：

方法＆＃39;范围＆＃39;对象＆＃39; _Worksheet＆＃39;失败

调试突出显示部件：

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

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

运行时错误＆＃39; 9＆＃39;：

下标超出范围

调试突出显示部件：

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)。

这样可以解决问题吗？

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

1 个答案: