如果範圍存在於目標中，VBA進行比較其他添加缺失範圍12次

Question

我目前能夠檢查Sheet-1的列A值是否存在於Sheet-2的列A中並添加缺少的12次。但是，不過，我想檢查Sheet-1上的列A & B組合是否存在於Sheet-2的列A & B中，並添加缺失的12次。以下是我需要的一點說明。

正如您所見，Sheet-2 Column-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 

以下是我已經用於檢查表-1值的列-A在表-2存在與否然後添加缺少的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 

Answer 3

小號不使用字典或數組。

Sub MergeMissing() 
    Dim lngRowNumber As Long 
    Dim lngTargetRow As Long 
    Dim i As Long 
    Dim rowIndex As Long 
    Dim flag As Long 

    lngTargetRow = ThisWorkbook.Worksheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Row 

    For lngRowNumber = 1 To ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row 
     'below line is a formula giving 1 if values already exists else 0 
     flag = Evaluate("COUNTIFS(Sheet2!A:A,Sheet1!A" & lngRowNumber & ",Sheet2!B:B,Sheet1!B" & lngRowNumber & ")") 
     If flag = 0 Then 
      For i = lngTargetRow To lngTargetRow + 11 
       ThisWorkbook.Worksheets("Sheet2").Cells(i + 1, "A").Value = ThisWorkbook.Worksheets("Sheet1").Cells(lngRowNumber, "A") 
       ThisWorkbook.Worksheets("Sheet2").Cells(i + 1, "B").Value = ThisWorkbook.Worksheets("Sheet1").Cells(lngRowNumber, "B") 
      Next i 
      lngTargetRow = lngTargetRow + 12 
     End If 
    Next lngRowNumber 
End Sub 

讓我知道是否有什麼不清楚。