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

【问题标题】：Vba macro to verify if a table contains the data of another table and copy the rowsVba宏来验证一个表是否包含另一个表的数据并复制行
【发布时间】：2020-06-14 07:36:42
【问题描述】：

我在两个不同的工作表中有两个表：一个表包含我手动输入的源数据（在“路线图数据”表中），另一个表（在“概览”表中）是另一个要保存的容器路线图数据表中可能更改的数据。我的目标是复制路线图数据表中的表行，前提是该行尚未出现在概览表的表中。下面是我写的代码，灵感来自另一个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 循环，用“或”条件循环概览表的行，但我无法想象如何做到这一点。任何简化我用来验证两个表的行是否相同的条件的建议都值得赞赏。

【问题讨论】：

标签： excel vba for-loop copy rows

【解决方案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

【讨论】：

谢谢，它有效，也许我会尝试提高效率，因为行数很多，它有点慢。但我现在的大问题是复制行不是在末尾而是在第 3 行，因此概览表中的表格可以自动调整大小。您对此有什么建议吗？
@codeghi：（1）“Roadmap_Data”和“Overvie”有什么区别。看起来两个表中的数据相同？！如果是这样，为什么不复制所有数据？为什么要检查？（2）我认为“......概览表自动调整大小......”的含义是“在概览中调整表（Listobject）的大小。而不是复制到数据的末尾，您可以向Listobject添加一个新行。（3 ) 为了提高效率，请参见第 (1) 点，或者您可以在“Roadmap_Data”中插入一个标志列，如果该行被复制，则标志 =“已复制”。所以您只需复制所有带有标志 =“”的行... .

【解决方案2】：

@克里斯

路线图数据包含添加的新行或由列中的某些值修改的相同行，例如第 4、6 或 6 列中的日期和值更改。当我更改行时，我想保留旧值并这就是我创建概览表的原因，该表包含当前值以及之前的值，方法是检查两张表之间单元格中的内容。

我刚刚更新了代码，如下所示，看起来没问题：

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

【讨论】：