Question

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

正如您所见，Sheet-2 Column-A＆amp; B没有1A和A的组合。因此，我们需要将这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中是否存在Sheet-1值的Column-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 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 2

使用此：

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 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

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

VBA比较如果目的地中存在范围，则添加缺失范围12次

3 个答案: