如何使用VBA在Excel中使用其单元格值在每列中查找重复项？

Question

I want to find the duplicates and highlight it in each column of the active worksheet in Excel 2010 using the cell value specified by us. For instance, There are 5 columns namely "S.No","ID","Name","Desc", and "Amount" which is default all the time (Note: Column value is always same whereas column number may differ each time). So, In this case, I want to find duplicates based on column value. If column X="S.No" then, find duplicates and highlight it.. and/or if column X="ID" find duplicated and highlight it.

I have a code with me, but this works only for column A. Please help me in providing the updates to find all the duplicates in every column in the active worksheet as explained above.

Sub DupEntry()
Dim cel As Variant
Dim rng As Range
Dim clr As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Set rng = Range("A1:A" & Range("A1048576").End(xlUp).Row)
rng.Interior.ColorIndex = xlNone
clr = 3
For Each cel In rng
If Application.WorksheetFunction.CountIf(rng, cel) > 1 Then
If WorksheetFunction.CountIf(Range("A1:A" & cel.Row), cel) = 1 Then
cel.Interior.ColorIndex = clr
clr = clr + 1
Else
cel.Interior.ColorIndex = rng.Cells(WorksheetFunction.Match(cel.Value, rng, False), 1).Interior.ColorIndex
End If
End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

Answer 1

You can achieve the desired effect by using "Conditional Formatting" feature in Excel Worksheet:

1. Select Column A

2. Click on Conditional Formatting menu button, then select "Highlight Cells Rules" and "Duplicates Values": specify the color from Drop-Down list.

3. Repeat the same steps for other Columns.

In case you prefer to use your VBA solution which highlights duplicates with different colors, then just apply it to other Columns: see that line

Set rng = Range("A1:A" & Range("A1048576").End(xlUp).Row)

so, instead of Column "A" use Column "B", etc. I would recommend to use iteration through the specified Columns range. With minor changes it can be implemented as shown in the following sample code snippet:

Sub DupEntry()
Dim cel As Variant
Dim rng As Range
Dim clr As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'Sample Array of Columns
Dim Col(1 To 3) As String
Col(1) = "A"
Col(2) = "B"
Col(3) = "C"

'Iterate through Columns
For i = 1 To 3
    'Set rng = Range("A1:A" & Range("A1048576").End(xlUp).Row)
    Set rng = Range(Col(i) & "1:" & Col(i) & Range(Col(i) & "1048576").End(xlUp).Row)
    rng.Interior.ColorIndex = xlNone
    clr = 3
    For Each cel In rng
        If Application.WorksheetFunction.CountIf(rng, cel) > 1 Then
            'If Application.WorksheetFunction.CountIf(Range("A1:A" & cel.Row), cel) = 1 Then
            If Application.WorksheetFunction.CountIf(Range(Col(i) & "1:" & Col(i) & cel.Row), cel) = 1 Then
                cel.Interior.ColorIndex = clr
                clr = clr + 1
            Else
                cel.Interior.ColorIndex = rng.Cells(WorksheetFunction.Match(cel.Value, rng, False), 1).Interior.ColorIndex
            End If
        End If
    Next
Next i
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

(original code lines are commented off). Alternatively, you can use cells R1C1 notation.

Hope this will help. Best regards,