检查重复数据

Question

我有这个代码可以检查重复并将数据复制到另一张纸上。 我想知道 VBA 是否还可以根据第一个重复行来写入是否是重复的数字 1、2 等等。如果可能的话，我希望在 BK 列中写入 Duplicate 1、Duplicate 2 等。

   'Cek Duplikat pindahin ke sheet tempcek (cek melihat ke email)
    Dim objDic As Object, rngData As Range
    Dim i As Long, sKey As String, dupRng As Range, rowRng As Range
    Dim arrData, oSht1 As Worksheet, oSht2 As Worksheet
    Const KEY_COL = "T" ' Col [Email]
    Const COL_CNT = 20 ' Col A to T
    Set objDic = CreateObject("scripting.dictionary")
    Set oSht1 = Sheets("ALL")
    Set oSht2 = Sheets("tempcek")
    ' load data from sheet1
    With oSht1
        Set rngData = .Cells(1, KEY_COL).Resize(.Range(KEY_COL & .Rows.Count).End(xlUp).Row)
    End With
    arrData = rngData.Value
    If Not VBA.IsArray(arrData) Then
        MsgBox "No data is on Sheet1.", vbCritical
        Exit Sub
    End If
    ' load data into Dict
    For i = LBound(arrData) + 1 To UBound(arrData)
        arrData(i, 1) = CStr(arrData(i, 1))
        sKey = arrData(i, 1)
        Set rowRng = oSht1.Cells(i, 1)
        If objDic.Exists(sKey) Then
            If dupRng Is Nothing Then
                Set dupRng = Application.Union(rowRng, objDic(sKey))
            Else
                Set dupRng = Application.Union(dupRng, rowRng, objDic(sKey))
            End If
        Else
            Set objDic(sKey) = rowRng
        End If
    Next i
    If Not dupRng Is Nothing Then
        Debug.Print dupRng.Address
       dupRng.EntireRow.Copy oSht2.Range("A2")
    End If

Answer 1

• 添加代码片段以填充 BK。

注意：未经测试的代码。如果输出不符合您的预期，请分享示例数据。

如何创建最小的、可重现的示例

请使用在线工具Table Generator

创建MD表

    Dim objDic As Object, rngData As Range
    ' Your code
    If Not dupRng Is Nothing Then
        Debug.Print dupRng.Address
       dupRng.EntireRow.Copy oSht2.Range("A2")
    End If
    ' ====================
    ' ** New code 
    Dim rngData2 As Range, arrKey, arrRes
    Const FLAG_COL = "BK"
    Set rngData2 = oSht2.Range("A2:A" & oSht2.Range(KEY_COL & oSht2.Rows.Count).End(xlUp).Row)
    ' Load data into array
    arrKey = rngData2.Columns(KEY_COL).Value     
    arrRes = rngData2.Columns(FLAG_COL).Value
    For i = LBound(arrKey) To UBound(arrKey)
        If objDic.Exists(arrKey(i, 1)) Then
        ' populate Col BK
        arrRes(i, 1) = "Duplicate " & objDic(arrKey(i, 1)).Row
    Next 
    rngData2.Columns(FLAG_COL).Value = arrRes
    ' ====================