比较2个工作簿中的2列，如果find匹配，则复制匹配的行

我有两个工作簿（或两张）：工作簿A和工作簿B.我想比较：工作簿A中的列B和C与工作簿B中的列A和B如果find匹配那么我需要将MATCHED行从工作簿B并将其粘贴到工作簿A上的MATCHED行。换句话说：我需要将工作簿B的匹配行的列C和D的单元格值复制到工作簿A中匹配行的列D和E的单元格中。

我到目前为止只比较了我所希望的两列是正确的。 下面的代码是2张而不是两个工作簿：

Sub compareNcopy() Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets(2): Set sh3 = Sheets(3) Dim i As Long, j As Long, Dim lr1 As Long, lr2 As Long Dim nxtRow As Long Dim rng1 As Range, rng2 As Range, rng3 As Range lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lr1 Set rng1 = sh1.Range("A" & i) For j = 1 To lr2 Set rng2 = sh2.Range("A" & j) If StrComp(CStr(rng1.Value), CStr(rng2.Value), vbTextCompare) = 0 Then If rng1.Offset(0, 1).Value = rng2.Offset(0, 1).Value Then End If End If Set rng2 = Nothing Next j Set rng1 = Nothing Next i End Sub 

帮助将不胜感激。

Answer 1

在两张（甚至两本书）之间进行复制与复制到同一张纸（或书）中的另一个单元时几乎相同，只需指定哪张纸（或书本）即可。 你想要做的是沿着以下几点：

 sh2.Cells(j,3).Resize(1,2).Copy Destination:=sh1.Cells(i,3).Resize(1,2) 

这是为了在sh2find要复制的数据。 如果相反，切换sh2和sh1 ， j和i 。

如果要在工作簿之间进行复制，则需要添加Workbooks(wb1). 在Sheets(sh2).前面Sheets(sh2). 说明符，其中wb1是工作簿variables。

编辑：因为sh2本质上是Sheets(2)我以前显示的是Sheets(Sheets(2))没有任何意义，这就是为什么错误popup。 我很抱歉。 而不是使用Sheets(sh2)只使用sh2 ， sh1 。 我已经修复了上面的代码来反映这一点。