在工作表之间比较和复制数据 [英] Compare and copy data between worksheets

问题描述

这是我要做的：

• IF
  
  <工作表A的单元格H =工作表B的单元格E（包含单词）和


• 工作表的单元格A =单元格工作表B（包含数字）H（工作表B的单元格（包含数字））

THEN

• 将工作表A的单元格O复制到单元格L的工作表B（包含数字）

换句话说：

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

我想要的宏应该匹配和复制A和B的整个工作表。来自工作表A的数据只能使用一次。 p>

---

这是我到目前为止，但似乎不起作用。

  Dim sh1 As Worksheet，sh2 As Worksheet 
 Dim j As Long，i As Long，lastrow As Long 
 Set sh1 = Worksheets（Worksheet A）
设置sh2 =工作表（Worksheet B）
 
 lastrow = sh1.Cells（Rows.Count，A）。End（xlUp）.Row 
 
对于i = 2 Torowrow 
j =（i  -  2）* 4 + 1 
如果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）。然后
 sh1.Cells（i，O）。复制sh2.Cells（j，L）
 End If 
j = j + 4 
下一个
  

解决方案

更新您需要两个循环才能执行。这个新的子程序适用于任何行。只需要小心多个比赛，因为它只需要最后一场比赛：

  Sub CopyCells（）
 Dim sh1 As工作表，sh2作为工作表
 Dim j As Long，i As Long，lastrow1 As Long，lastrow2 As Long 
 Set sh1 = Worksheets（Worksheet A）
设置sh2 = Worksheets（Worksheet B）
 
 lastrow1 = sh1.Cells（Rows.Count，A）。End（xlUp）.Row 
 lastrow2 = sh2.Cells（Rows.Count，A） .End（xlUp）.Row 
 
对于i = 2 To lastrow1 
对于j = 1 To lastrow2 
如果sh1.Cells（i，H）。Value = sh2 .Cells（j，E）。Value And _ 
 sh1.Cells（i，J）。Value = sh2.Cells（j，H）。Value And _ 
 sh1。单元格（i，K）Value = sh2.Cells（j，I）。然后
 sh1.Cells（i，L）Value = sh2.Cells（j，O ）.Value 
 End If 
 Next j 
 Next i 
 End Sub 
  

Here's what I would like to do:

• IF
  • cell H of worksheet A = cell E of worksheet B (contain words) and
  • cell J of worksheet A = cell H of worksheet B (contain numbers) and
  • cell K of worksheet A = cell I of worksheet B (contain numbers)
• THEN
  • copy cell O of worksheet A to cell L of worksheet B (contain numbers)

In other words:

• If H2, J2, K2 of worksheet A = E1, H1, I1 of worksheet B, then copy O2 of worksheet A to L1 of worksheet B.
• If H3, J3, K3 of worksheet A = E5, H5, I5 of worksheet B, then copy O3 of worksheet A to L5 of worksheet B.

The macro I want should match and copy for the whole worksheet of A and B. Data from worksheet A is only to be used once.

---

Here's is what I have so far, but it doesn't seem to work.

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

解决方案

Update You need two loops for what you want to do. This new subroutine works for any row. Just be careful of multiple matches because it will take only the last match:

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

这篇关于在工作表之间比较和复制数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！