Question

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

我需要做如下：

将G列，Worksheet1中的每个值与D列，工作表2中的唯一值进行比较。
如果值匹配，请从列中复制该行的值：C，G＆amp;我
将每个匹配粘贴到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 列中的值等。

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

Answer 2

我会使用Cells属性和一个Do循环来遍历WS1上的G.尝试这样的事情：

Dim i as Integer, j as Integer
Dim c as Range
i = 2 'Will be used to loop through WS1, Column G
j = 1 'Will be used to find next empty row in WS3

Do Until Sheets(1).Cells(i, 7).Value = ""

    Set c = Sheets(2).Range("D2")
        Do Until c.value = Sheets(1).Cells(i, 7).Value Or c.value = ""
            Set c = c.Offset(1, 0)
        Loop

    If c.value = Sheets(1).Cells(i, 7).Value Then
        'Find first empty row in WS3
        j = 1
        Do Until Sheets(3).Cells(j, 1).Value = ""
            j = j + 1
        Loop

        'Copy row
        Sheets(3).Rows(j).value = Sheets(1).Rows(I).value

    End if

    i = i + 1

Loop

Set c = Nothing

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

2 个答案:

VBA代码的替代