VBA比较如果范围存在于目的地否则添加丢失范围12倍

我目前能够检查Sheet-1的列A值是否存在于Sheet-2的列A中，并添加缺less的12次。 但是，我想检查Sheet-1上的A和B组合是否存在于Sheet-2上的A和B列上，并添加缺less的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 

下面是我写的用于检查Sheet-1值的Column-A是否存在于Sheet-2中的代码，然后添加缺less的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

解决scheme不使用字典或数组。

 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 

如果有什么不清楚，请告诉我。