在工作表之间比较和复制数据

这是我想要做的:

  • 如果
    • 工作表A的单元格H =工作表B的单元格E(包含单词)
    • 工作表A的单元格J =工作表B的单元格H(包含数字)
    • 工作表A的单元格K =工作表B的单元格I(包含数字)
  • 然后
    • 将工作表A的单元格O复制到工作表B的单元格L(包含数字)

换一种说法:

  • 如果工作表A的H2,J2,K2 =工作表B的E1,H1,I1,则将工作表A的O2复制到工作表B的L1。
  • 如果工作表A的H3,J3,K3 =工作表B的E5,H5,I5,则将工作表A的O3复制到工作表B的L5。

我想要的macros应匹配和复制A和B的整个工作表。工作表A中的数据只能使用一次。


这是我迄今为止,但它似乎并没有工作。

Dim sh1 As Worksheet, sh2 As Worksheet Dim j As Long, i As Long, lastrow As Long Set sh1 = Worksheets("Worksheet A") Set sh2 = Worksheets("Worksheet B") lastrow = sh1.Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastrow j = (i - 2) * 4 + 1 If sh1.Cells(i, "H").Value = sh2.Cells(j, "E").Value And _ sh1.Cells(i, "J").Value = sh2.Cells(j, "H").Value And _ sh1.Cells(i, "K").Value = sh2.Cells(j, "I").Value Then sh1.Cells(i, "O").Copy sh2.Cells(j, "L") End If j = j + 4 Next 

更新你想要做什么需要两个循环。 这个新的子程序适用于任何行。 只需要小心多个比赛,因为它只需要最后一场比赛:

 Sub CopyCells() Dim sh1 As Worksheet, sh2 As Worksheet Dim j As Long, i As Long, lastrow1 As Long, lastrow2 As Long Set sh1 = Worksheets("Worksheet A") Set sh2 = Worksheets("Worksheet B") lastrow1 = sh1.Cells(Rows.Count, "A").End(xlUp).Row lastrow2 = sh2.Cells(Rows.Count, "A").End(xlUp).Row For i = 2 To lastrow1 For j = 1 To lastrow2 If sh1.Cells(i, "H").Value = sh2.Cells(j, "E").Value And _ sh1.Cells(i, "J").Value = sh2.Cells(j, "H").Value And _ sh1.Cells(i, "K").Value = sh2.Cells(j, "I").Value Then sh1.Cells(i, "L").Value = sh2.Cells(j, "O").Value End If Next j Next i End Sub