VBA 根据多列检查重复项并显示哪一行与哪一行重复

VBA to check duplicate based on multiple columns and show which row is duplicating with which one

我的 excel 有从 A 列到 AH 列的数据,我想做的是,

  1. 根据前三列检查重复项
  2. 插入一列作为第一列,并将重复的行标记为重复以及重复的行号

我尝试了以下基于单列的代码,但发现很难在多列中制作并指示行号,任何想法将不胜感激。

 Sub FindDuplicatesInColumn()
'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column using For loop
    Dim iCntr As Long

'test the column A and insert a column or clear data
    If Range("A1").Value = "PDBC_PFX" Then
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "DUPE_CHECK"
    Else
        Range("A2:A65000").Clear
    End If

'Finding the last row in the Column B
    lastRow = Range("B65000").End(xlUp).Row

'looping through the column B
    For iCntr = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 2) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
                'Printing the label in the column A
                Cells(iCntr, 1) = "Duplicate"
            End If
        End If
    Next

'auto fit column A
    Columns("A").AutoFit

End Sub

我尝试了简单的连接,我比较熟悉,但仍然无法弄清楚添加行号,而且它有点慢,让我知道如何改进下面的代码并添加行号复制与.

Sub FindDuplicatesInColumn()
'Declaring the lastRow variable as Long to store the last row value in the Column1
    Dim lastRow As Long

'matchFoundIndex is to store the match index values of the given value
    Dim matchFoundIndex As Long

'iCntr is to loop through all the records in the column using For loop
    Dim iCntr As Long

'test the column A and insert a column or clear data
    If Range("A1").Value = "PDBC_PFX" Then
        Range("A1").EntireColumn.Insert
        Range("A1").EntireColumn.Insert
        Range("A1").Value = "DUPE_CHECK"
        Range("B1").Value = "KEY"
    ElseIf Range("B1").Value = "PDBC_PFX" Then
        Range("B1").EntireColumn.Insert
        Range("B1").Value = "KEY"
    Else
        Range("A2:B65000").Clear
    End If

'Finding the last row in the Column B
    lastRow = Range("C65000").End(xlUp).Row

'add a key for the columns to check
    Range("B2:B" & lastRow).FormulaR1C1 = "=RC[1]&RC[2]&RC[3]"
    Range("B:B").Value = Range("B:B").Value


'looping through the column B
    For iCntr = 1 To lastRow
        'checking if the cell is having any item, skipping if it is blank.
        If Cells(iCntr, 2) <> "" Then
            'getting match index number for the value of the cell
            matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 2), Range("B1:B" & lastRow), 0)
            'if the match index is not equals to current row number, then it is a duplicate value
            If iCntr <> matchFoundIndex Then
                'Printing the label in the column A
                Cells(iCntr, 1) = "Duplicate"
            End If
        End If
    Next

'auto fit column A
    Columns("A").AutoFit

'remove key column after validation
    Columns("B").Delete

End Sub