Блог

Я пытаюсь сравнить два столбца двух листов, а затем скопировать дубликаты данных на новый лист.

Ее код у меня сейчас есть.

 Sub CopyDuplicates()
    MsgBox "Process begin now. if you cannot see any result after processing, " amp; _
           "it means there is no duplicate data between two sheets."
    
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim lr1 As Long, lr2 As Long, r As Long, r3 As Long
    Dim ar As Variant, i As Long
    
    Set ws1 = Sheets("Sheet1")
    Set ws2 = Sheets("Sheet2")
    Set ws3 = Sheets("Sheet3")
    ws3.Cells.Clear

    lr1 = ws1.UsedRange.Rows.Count
    lr2 = ws2.UsedRange.Rows.Count
    ws1.UsedRange.Interior.ColorIndex = xlNone
    ws2.UsedRange.Interior.ColorIndex = xlNone

    ' build dictionary from sheet2 col B
    Dim dict, key As String
    Set dict = CreateObject("Scripting.Dictionary")
    
    For r = 1 To lr2
        key = Trim(ws2.Cells(r, "B"))
        If Len(key) > 0 Then
            If dict.exists(key) Then
                dict(key) = dict(key) amp; ";" amp; r
            Else
                dict.Add key, r
            End If
        End If
    Next

    Application.ScreenUpdating = False
    r3 = 1 ' sheet3
    ' scan sheet 1 looking for to match with sheet 2
    For r = 1 To lr1
        key = Trim(ws1.Cells(r, "B"))
        If dict.exists(key) Then
            ' copy multiple matches
            ar = Split(dict(key), ";")
            For i = LBound(ar) To UBound(ar)
                ws1.Range("A" amp; r).Resize(1, 6).Copy ws3.Range("A" amp; r3) ' A:F
                ws2.Range("A" amp; ar(i)).Resize(1, 17).Copy ws3.Range("G" amp; r3) ' A:Q
                r3 = r3   1
            Next
        End If
    Next
   
    Application.ScreenUpdating = True
    MsgBox "Process finished"
End Sub
 

Он может сравнивать только один столбец из 2 листов, то есть столбцы B. Но я хочу сравнить столбцы B и C, когда оба столбца B и C двух листов совпадают, скопируйте всю строку данных на новый лист(лист3).

 This is my expected return：

I assume that sheet1 and sheet2 only have column A B C


A     B     C     D     E    F
GRF HO1335 KKK   BLG HO1335 KKK
GRF HO1335 KKK   SKT HO1335 KKK
GRF HO1335 KKK   T1  HO1335 KKK
DWG HO1335 HHH   CLG HO1335 HHH
DWG HO1335 HHH   FNC HO1335 HHH
DWG HO1335 HHH   BYG HO1335 HHH

 

Могу я спросить, как я могу сравнить две колонки одновременно?
Я все еще новичок в VBA, поэтому я не так хорошо знаком с этим. Большое вам спасибо за вашу помощь.