Arrays 仅复制目标表中不存在的记录

拥有两个表（源表和目标表）意味着仅复制源表中不存在于目标表中的记录（与每个记录中特定单元格的值进行比较）。我本想用数组来做，但由于我是这方面的新手，所以需要帮助

示例：

源表

ID日期说明

115 01年前描述1

120 05年前的描述2

130 03年前的描述5

110 08年前描述4

105 06年前描述6

目的表

ID日期说明

130 03年前的描述5

110 08年前描述4

我想从源表中添加目标表中不存在的记录（本例中ID为115120105）。谢谢大家!

我快到了。在咨询了其他一些问题之后，我需要这样的东西：

子测试（）

端接头

但现在，我有两个问题之一：

若我将MyArray声明为字符串类型，那个么将值加载到数组时就会出现问题

如果我将MyArray声明为variant类型，则在联接中会出现问题

---

有人能帮我吗？

在源数据中添加一个查找，将每条记录标记为存在或不存在，然后将宏从该列中弹出（即，仅当查找=不存在时才将其移动到目标中）。

您所需要的是使用集合对象或字典对象。当您尝试查找唯一记录时，这些对象非常有用

让我们举一个例子，我们有两张表：源和目标

您需要在两个工作表中循环A列，并将数据从源工作表移动到目标工作表。下面是未经测试的代码，但它应该可以做到这一点。我添加了一些评论，这样你就可以很容易地理解并适应你的情况

Dim ids As Collection


Sub MoveData()


   On Error GoTo MoveData_Error

    Set ids = New Collection

    Dim sourceRange As Range
    Dim idRange As Range

    Dim cell As Range




    Set sourceRange = Range("A1:A100") 'assign your source range here. Code will try to pick ID in this range, and check in ID Range
    Set idRange = Range("A1:A100") ' assign your target range here. Code will find the ID in this range


    'load all ids from target range in the collection.

    On Error Resume Next ' suppressing the error if any duplicate value is found

    For Each cell In idRange.Cells
            ids.Add cell.Value, cell.Value ' adding in collection to maintain a unique collection
            Err.Clear
    Next cell

    On Error GoTo MoveData_Error


    'now I have information about all the availabe IDs in id collection. Now I will loop through to check


    For Each cell In sourceRange
        If ShouldCopy(cell) Then
            'write your code to copy
        End If
    Next cell


   On Error GoTo 0
   Exit Sub

MoveData_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MoveData of VBA Document Sheet1"

End Sub


Public Function ShouldCopy(cell As Range) As Boolean

   On Error GoTo ShouldCopy_Error
    If cell.Value = "" Or IsEmpty(cell.Value) Then Exit Function

    ids.Add cell.Value, cell.Value ' if error occurs here, then it means the id has been already moved or found in the ID worksheet range
    ShouldCopy = True
   On Error GoTo 0
   Exit Function

ShouldCopy_Error:
    ShouldCopy = False
End Function

如果您在理解方面遇到任何问题，需要任何帮助，请告诉我

谢谢，

---

V

您可以添加一些示例数据吗？这将有助于理解您试图实现的目标。这些是实际的Excel表格还是数据区域？它们是Excel表格的简单示例，只是为了简化问题谢谢Tim，但我不想使用公式。我的想法是加载目标表的数组ID，并在源表中比较数组中存在的每个ID。如果不存在，请复制该行。可能吗？这有意义吗？是的，但我现在不在一台可以为你提供代码的机器附近；它包括加载目标表中包含值的数组，然后使用新集合将源中的值与数组中的值进行比较。作为一种快速而肮脏的解决方法，为什么不复制所有内容，然后使用宏删除所有重复项？还有其他问题不允许我这样做。另一方面，我发布的代码有问题吗？很抱歉，ShouldCopy函数也有同样的问题。没有哈本的。如果我忽略“On Error GoTo ShouldCopy_Error”，它会给我“MoveData_Error:”中的消息框。在研究了有关集合的更多信息后，我尝试将项添加到集合中而不使用键（仅

ids.Add cell.Value

），它不会给我更多错误（错误13类型不匹配）。同时，现在它无法识别目标表中的ID。有什么帮助吗？我修复了将键转换为字符串的问题-

ids.Add cell.Value，Cstr（cell.Value）

。靠你的帮助打败你！对不起，伙计，这个周末我没有足够的时间浏览你的评论。很高兴你自己解决了问题。干杯

Dim ids As Collection


Sub MoveData()


   On Error GoTo MoveData_Error

    Set ids = New Collection

    Dim sourceRange As Range
    Dim idRange As Range

    Dim cell As Range




    Set sourceRange = Range("A1:A100") 'assign your source range here. Code will try to pick ID in this range, and check in ID Range
    Set idRange = Range("A1:A100") ' assign your target range here. Code will find the ID in this range


    'load all ids from target range in the collection.

    On Error Resume Next ' suppressing the error if any duplicate value is found

    For Each cell In idRange.Cells
            ids.Add cell.Value, cell.Value ' adding in collection to maintain a unique collection
            Err.Clear
    Next cell

    On Error GoTo MoveData_Error


    'now I have information about all the availabe IDs in id collection. Now I will loop through to check


    For Each cell In sourceRange
        If ShouldCopy(cell) Then
            'write your code to copy
        End If
    Next cell


   On Error GoTo 0
   Exit Sub

MoveData_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure MoveData of VBA Document Sheet1"

End Sub


Public Function ShouldCopy(cell As Range) As Boolean

   On Error GoTo ShouldCopy_Error
    If cell.Value = "" Or IsEmpty(cell.Value) Then Exit Function

    ids.Add cell.Value, cell.Value ' if error occurs here, then it means the id has been already moved or found in the ID worksheet range
    ShouldCopy = True
   On Error GoTo 0
   Exit Function

ShouldCopy_Error:
    ShouldCopy = False
End Function