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

我是新的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) 

variablesj引用Worksheet2中的一行，但在Worksheet1上使用它。 根据你在这里的意图，你应该改变工作表名称或使用variables我而不是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列）中find它并返回find它的行号。 最后一个参数（0）确保只有完全匹配数。

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

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

您可以通过$H:$H更改$C:$C以获取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