要比较目标中是否存在范围，请将缺失范围添加12次

Question

我目前能够检查表-1上的A列是否存在于表-2的列A中，并将丢失的值添加12次。但是，我想检查一下表格-1上的A&B列组合是否存在于表-2的A&B列中，并添加12次缺失。下面是我需要的一个小例子。

如您所见，表-2列-A&B没有1A和2A的组合，因此我们需要将这12次添加到Sheet-2中。

      Sheet-1                              Sheet-2
Column-A   Column-B                  Column-A  Column-B
   1           1                          1        1
   1A          2A                         1        4
                                          2B       3B

下面是我编写的代码，用于检查Sheet-2中是否存在表-1值的-A列，然后将丢失的值添加12次：

'Sub MergeMissing()
 Dim xlsData As Worksheet
 Dim xlsTracker As Worksheet
 Dim lngRowNumber As Long
 Dim lngTargetRow As Long
 Dim rngDataCell As Range
 Dim dctIndex As Object
 '# initialise
 Set xlsData = ThisWorkbook.Worksheets("Sheet-1")
 Set xlsTracker = ThisWorkbook.Worksheets("Sheet-2")
 Set dctIndex = CreateObject("Scripting.Dictionary")
 dctIndex.CompareMode = 1
 '# build index of existing values
 With xlsTracker
 lngTargetRow = .Cells(.Rows.Count, "A").End(xlUp).Row
  For lngRowNumber = 1 To lngTargetRow
     If Not dctIndex.Exists(.Cells(lngRowNumber, "A").Value) Then
        dctIndex.Add .Cells(lngRowNumber, "A").Value, lngRowNumber
     End If
  Next lngRowNumber
 End With
 '# copy data that does not exist as yet
 With xlsData
  For lngRowNumber = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
     If Not dctIndex.Exists(.Cells(lngRowNumber, "A").Value) Then
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber,    "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
         lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
         lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
        lngTargetRow = lngTargetRow + 1
        xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
     End If
  Next lngRowNumber
  End With

  End Sub

Answer 1

用这个：

Sub test()
    Dim timelinessSheet As Variant
timelinessSheet = Worksheets("sheet1").Range("A1:B" & Worksheets("sheet1").Cells(Worksheets("sheet1").Rows.Count, "A").End(xlUp).Row).Value
Dim timelinessSheet2 As Variant
timelinessSheet2 = Worksheets("sheet2").Range("A1:B" & Worksheets("sheet2").Cells(Worksheets("sheet2").Rows.Count, "A").End(xlUp).Row).Value
Dim i as long,j as long
For i=1 to UBound (timelinessSheet ,1)
For j=1 to UBound (timelinessSheet2,1)
concatenate =""
concatenate2 =""
concatenate = concatenate & timelinessSheet(i,1) & " " & timelinessSheet(i,2)
concatenate2 = concatenate2 & timelinessSheet2(j,1) & " " & timelinessSheet2(j,2)
if concatenate <> concatenate2 And j= UBound (timelinessSheet2,1) then 
Worksheets("sheet2").Range(ubound (timelinessSheet2,1),1)= timelinessSheet(i,1)
Worksheets("sheet2").Range(ubound (timelinessSheet2,1),2)= timelinessSheet(i,2)
end if 
next j 
next i 
end sub

Answer 2

试试这个：

Sub MergeMissing()
    Dim xlsData As Worksheet
    Dim xlsTracker As Worksheet
    Dim lngRowNumber As Long
    Dim lngTargetRow As Long
    Dim rngDataCell As Range
    Dim dctIndex As Object
    '# initialise
    Set xlsData = ThisWorkbook.Worksheets("Sheet-1")
    Set xlsTracker = ThisWorkbook.Worksheets("Sheet-2")
    Set dctIndex = CreateObject("Scripting.Dictionary")
    dctIndex.CompareMode = 1

    '# build index of existing values
    With xlsTracker
       lngTargetRow = .Cells(.Rows.Count, "A").End(xlUp).Row
       For lngRowNumber = 1 To lngTargetRow
           Dim strCombination As String
           strCombination = .Cells(lngRowNumber, "A").Value & " # " & .Cells(lngRowNumber, "B").Value
           If Not dctIndex.Exists(strCombination) Then
               dctIndex.Add strCombination, lngRowNumber
           End If
       Next lngRowNumber
    End With

    '# copy data that does not exist as yet
    With xlsData
       For lngRowNumber = 1 To .Cells(.Rows.Count, "A").End(xlUp).Row
       Dim strTargetCombination As String
       strTargetCombination = .Cells(lngRowNumber, "A").Value & " # " & .Cells(lngRowNumber, "B").Value
       If Not dctIndex.Exists(strTargetCombination) Then
           For i = 1 To 12
               lngTargetRow = lngTargetRow + 1
               xlsTracker.Cells(lngTargetRow, "A").Value = .Cells(lngRowNumber, "A").Value
               xlsTracker.Cells(lngTargetRow, "B").Value = .Cells(lngRowNumber, "B").Value
           Next
       End If
       Next lngRowNumber
    End With
End Sub