比較和複製工作表

Question

之間的數據這是我想要做什麼：工作表B的工作表A =電池E的

• IF
  • 細胞H（含字）和
  • 工作表A的單元格J =工作表B的單元格H（包含數字）和
  • 工作單元格K HEET A =小區工作表B的I（包含數字）
• THEN
  • 工作表A的複製單元O操作的工作表B的細胞L（包含數字）

換句話說：

• 如果工作表A = E的H2，J2，K2 1，H1，工作表B的I1，然後工作表A的複製O2到L1工作表B的
• 如果H3，J3，工作表A的K3 = E5，H5，工作表B的I5，然後工作表A的複製O3到工作表B的L5。

我想要的宏應該匹配並複製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 

Answer 1

更新你想要做什麼，你需要兩個循環的。這個新的子程序適用於任何行。只需要注意多個匹配，因爲它只需要最後的匹配：

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