在两张纸上找到匹配的行

Posted 2023-01-28

我有一个sheet1（sh1），其中我在（A2）中有一个国家名称，在（B2）中有一个方向。

我想在sheet2（sh2）上找到一行，其中A列包含相同的城市名称，B列包含相同的地区，并将整个行复制到sh1上匹配的行旁边。然后，我想遍历sh1上的所有行，并在sh2上找到匹配的行，然后以相同的方式将其复制。

似乎我正在复制数据，但sh2上的匹配行包含我想复制到sh1的其他信息。

以说明：

On Sheet1:

Column A               Column B
(header)               (header)
San Diego              South
New York               North
Chicago                East

On Sheet2:

Column A              Column B
(header)              (header)
Chicago               East              
San Diego             South
New York              North

循环将首先检查圣地亚哥，然后是纽约，然后是芝加哥，依此类推，直到该列结束。

这是我的代码：

Sub Matchcountry()

    Dim sh1 As Worksheet
    Dim sh2 As Worksheet
    Dim r As Range

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    r = lastrow = sh1.Range("A" & Rows.Count) + 2.End(xlUp).Row    

    For x = 1 To r    
        If sh1.Range("A" & x) = sh2.Range("A" & x) And sh1.Range("B" & x) = sh1.Range("A" & x) & sh2.Range("B" & x) Then 
            sh1.Range("A" & x).EntireRow.Copy Destination:=sh2.Range("C" & x)    
        x = x + 1    
    Next x

End Sub

答案

您已经很接近了，请尝试以下更正的代码（更正在注释中：]

Sub Matchcountry()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim r As Long, r2 As Long 'we just need the row number, not the Range object

Set sh1 = Sheets("Sheet1")
Set sh2 = Sheets("Sheet2")
r = sh1.Range("A" & Rows.Count).End(xlUp).Row 'All the necessary parts were there, just the syntax was wrong
r2 = sh2.Range("A" & Rows.Count).End(xlUp).Row

Dim x As Long, y As Long 'It's good practice to declare all your variables
For x = 1 To r
    For y = 1 To r2
        If sh1.Cells(x, 1).Value2 = sh2.Cells(y, 1).Value2 And sh1.Cells(x, 2).Value2 = sh2.Cells(y, 2).Value2 Then 'Again, most necessary parts were already there
            sh1.Range(sh1.Cells(x, 1), sh1.Cells(x, Columns.Count).End(xlToLeft)).Copy Destination:=sh2.Range("C" & y) 'We don't need the entire row, in fact we won't be able to copy it to the desired renage since it's too big
            Exit For 'will stop the second loop once it's found a match
        End If
    Next y
    'x = x + 1 Common mistake. Next x already iterates x, by doing it this way we skip every second step
Next x

End Sub

最大的变化是第二个For循环。我们需要第二个循环，因为您想循环遍历sh2的every行的sh1，只循环一次。