0

有两个表（源表和目标表）打算只复制源表中不存在于目标表中的记录（与每条记录中特定单元格的值进行比较）。我想用数组来做，但由于我是这个领域的新手，需要帮助。

例子：

源表

身份证 日期 说明

115 01-Ago 说明1

120 05-Ago 说明2

130 03-Ago 描述5

110 08-Ago 描述4

105 06-Ago 说明6

目的地表

身份证 日期 说明

130 03-Ago 描述5

110 08-Ago 描述4

我想从源表中添加目标表中不存在于目标表中的记录（本例中的 ID 为 115,120,105）。谢谢！

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

子测试（）

Dim MyArray() As String
Dim tgtLastRow, srcLastRow As Integer
Dim rngTarget, rngSource, cel As Range
Dim Delim As String

Delim = "#"

tgtLastRow = Range("H1").End(xlDown).Row
srcLastRow = Range("A1").End(xlDown).Row

Set rngTarget = Range("H2:H" & tgtLastRow)
Set rngSource = Range("A2:A" & srcLastRow)

MyArray = rngTarget.Value

strg = Join(MyArray, Delim)
strg = Delim & strg

For Each cel In rngSource
    If InStr(1, strg, Delim & cel.Value & Delim, vbTextCompare) Then
    Else
    'Copy the row or range here
    End If

Next cel

结束子

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

  1. 如果我将 MyArray 声明为字符串类型，我在将值加载到数组时遇到问题
  2. 如果我将 MyArray 声明为变体类型，我在 Join 中会遇到问题

任何人都可以帮我吗？

4

2 回答 2

0

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

于 2013-08-31T14:54:05.917 回答
0

您只需要使用 Collection 对象或 Dictionary 对象。当您尝试查找唯一记录时，这些对象很有帮助。

举个例子，我们有两张表：Source 和 Target。

您需要遍历两个工作表中的 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

于 2013-08-31T18:03:20.737 回答