Vba宏来验证一个表是否包含另一个表的数据并复制行

Question

我在两个不同的工作表中有两个表：一个表包含我手动输入的源数据（在“道路地图数据”表中），另一个表（在“概述”表中）将是另一个容器，用于保存路线图数据表中可能会更改的数据。我的目的是仅在“概述”表的表中尚未存在的情况下，复制“路线图数据”表中的表的行。在我编写的代码下面，我从另一个post

中汲取了灵感

Public Sub CopyRowsAcross()

Dim ione, itwo As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Roadmap Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Overview")

For ione = 3 To ws1.Range("B65536").End(xlUp).Row
    itwo = 3
    Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
        If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) Then
            Exit Do
        Else
            ws1.Rows(ione).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)
            Exit Do
        End If
    itwo = itwo + 1
    Loop
Next ione
End Sub

源数据是这样的：enter image description here

但是宏的结果是错误的：enter image description here

[我编写do until循环的方式可能有问题，我认为我需要一个for循环，该循环以“或”条件循环概述表的行，但是我无法想象该怎么做。任何简化我用来验证两个表的行是否相同的条件的建议都值得赞赏。

Answer 1

您的代码中的问题是，DO-LOOP没有检查ws2中的所有行。DO-LOOP中的第一个if检查ws2中的第一行，这是“ Act3” ...IF（“ Act3” =“ Act4”）？不，不是，所以请插入Act4。

尝试一下：

Public Sub CopyRowsAcross()

Dim ione as Integer, itwo As Integer
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Sheets("Roadmap Data")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Sheets("Overview")
Dim found As Boolean

For ione = 3 To ws1.Range("B65536").End(xlUp).Row
    itwo = 3
    found = False
    Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
        If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) _
           And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) _
           And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) _
           And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) _
           And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) _
           And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) _
           And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) _
           Then found = True
         itwo = itwo + 1

     Loop
         If found = False Then ws1.Rows(ione).Copy ws2.Rows(ws2.Cells(ws2.Rows.Count, 2).End(xlUp).Row + 1)

    Next ione
End Sub

Answer 2

@ Chris

1. 路线图数据包含新添加的行或由列中的某些值修改的相同行，例如，日期和值在第4、6或6列中的更改。当我更改行时，我想保留旧值，这就是我之所以创建“概述”表的原因，该表通过检查两张表之间的单元格中的内容，既包含当前值又包含先前值。

2. 我刚刚更新了代码，如下所示，看来还可以：

   For ione = 3 To ws1.Range("B65536").End(xlUp).Row
   itwo = 3
   found = False
   Do Until itwo = ws2.Range("B65536").End(xlUp).Row + 1
       If ws1.Cells(ione, 2) = ws2.Cells(itwo, 2) _
       And ws1.Cells(ione, 3) = ws2.Cells(itwo, 3) _
       And ws1.Cells(ione, 4) = ws2.Cells(itwo, 4) _
       And ws1.Cells(ione, 5) = ws2.Cells(itwo, 5) _
       And ws1.Cells(ione, 6) = ws2.Cells(itwo, 6) _
       And ws1.Cells(ione, 7) = ws2.Cells(itwo, 7) _
       And ws1.Cells(ione, 8) = ws2.Cells(itwo, 8) _
       Then found = True
       itwo = itwo + 1
   Loop
       If found = False Then
           ws2.Range("B3:H3").ListObject.ListRows.Add (1)
           ws1.Rows(ione).Copy ws2.Rows(3)
       End If
   Next ione