有两个表(源和目标)打算只复制源表中目标表中不存在的记录(与每个记录中特定单元格的值进行比较)。我想用数组来做,但是因为我是这个领域的新手,需要帮助。
示例:
来源表
ID日期说明
115 01-Ago Description1
120 05-Ago Description2
130 03-Ago Description5
110 08-Ago Description4
105 06-Ago Description6
目的地表
ID日期说明
130 03-Ago Description5
110 08-Ago Description4
我想在源表中添加目标表中不存在的目标表记录(在此示例中为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
End Sub
但是现在,我有两个问题之一:
任何人都可以帮助我吗?
答案 0 :(得分:0)
在您的源数据中添加一个查找,将每个记录标记为存在或不存在,然后将该宏从该列反弹(即只有在查找=缺席时才将其移动到目标中)。
答案 1 :(得分:0)
您只需要使用Either Collection对象或Dictionary对象。当您尝试查找唯一记录时,这些对象会有很大帮助。
让我们举个例子,我们有两张:源和目标。
您需要在两个工作表中循环遍历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