vba - 循环 - 匹配不同工作表中两列中的值，如果匹配则将整行复制到新工作表

Question

我是 VBA 编码的新手，非常感谢解决这个问题的一些帮助。

我需要执行以下操作:

将 G 列 Worksheet1 中的每个值与 D 列 Worksheet2 中的唯一值进行比较。

如果值匹配，则从列中的该行值复制:C、G 和 I

将每个匹配项粘贴到 Worksheet3

到目前为止，我已经尝试过:

Sub test()

    Application.ScreenUpdating = False

    Dim rng1 As Range, rng2 As Range, rngName As Range, i As Integer, j As Integer

    For i = 1 To Sheets("Worksheet1").Range("G" & Rows.Count).End(xlUp).Row
        Set rng1 = Sheets("Worksheet1").Range("G" & i)

    For j = 1 To Sheets("Worksheet2").Range("D" & Rows.Count).End(xlUp).Row
        Set rng2 = Sheets("Worksheet2").Range("D" & j)

        Set rngName = Sheets("Worksheet1").Range("H" & j)

        If rng1.Value = rng2.Value Then
        rngName.Copy Destination:=Worksheets("Worksheet3").Range("B" & i)
        End If

        Set rng2 = Nothing
    Next j
    Set rng1 = Nothing
 Next i

End Sub

但它不起作用。

Answer 1

这个说法有问题:

Set rngName = Sheets("Worksheet1").Range("H" & j)

变量 j 引用 Worksheet2 中的一行，但您在 Worksheet1 上使用它。根据您在此处的意图，您应该更改工作表名称或使用变量 i 而不是 j。

假设它是第一个，代码也可以写成:

Dim rng1 As Range, rng2 As Range

' Iterate over the used cells in the G column of Worksheet1
For Each rng1 In Sheets(1).UsedRange.Columns(8 - Sheets(1).UsedRange.Column).Cells
    ' Iterate over the used cells in the D column of Worksheet2
    For Each rng2 In Sheets(2).UsedRange.Columns(5 - Sheets(2).UsedRange.Column).Cells
        If rng1.Value = rng2.Value Then 
            ' Copy value from the C column in Worksheet2 to the B column in Worksheet3
            Sheets(3).Cells(rng2.Row, 2).Value = rng2.Offset(0, -1).Value 
        End If
    Next
Next

VBA 代码的替代方案

您可以使用公式而不是使用代码。

例如在 Worksheet3 中，您可以将此公式放在 B1 中:

=INDEX(Worksheet2!$C:$C, MATCH(Worksheet1!$G1,Worksheet2!$D:$D, 0))

以下是对该公式的两个主要部分的解释:

MATCH(Worksheet1!$G1, Worksheet2!$D:$D, 0)

这部分将取值 Worksheet1!$G1 , 在 Worksheet2!$D:$D 中找到它(即完整的 D 列)并返回找到它的行号。最后一个参数 (0) 确保只计算完全匹配。

INDEX(Worksheet2!$C:$C, ...)

MATCH 返回的行号将用于从同一行的 Worksheet2 的 C 列中获取值。

您可以更改 $C:$C通过 $H:$H从 H 列等中获取值。

向下拖动/复制公式以对其他行重复。