需要VBA在同一列中突出显示具有不同颜色的每组重复数据值

问题描述

示例:(这会持续数千行）

Example: (this goes on for thousands of rows)

C列

TAC

谢谢

推荐答案

您好 MichaelJerome，

您可以尝试使用以下代码。

you can try to use code below.

Sub ColorCompanyDuplicates()
'Updateby Extendoffice 20160704
    Dim xRg As Range
    Dim xTxt As String
    Dim xCell As Range
    Dim xChar As String
    Dim xCellPre As Range
    Dim xCIndex As Long
    Dim xCol As Collection
    Dim i As Long
    On Error Resume Next
    If ActiveWindow.RangeSelection.Count > 1 Then
      xTxt = ActiveWindow.RangeSelection.AddressLocal
    Else
      xTxt = ActiveSheet.UsedRange.AddressLocal
    End If
    Set xRg = Application.InputBox("please select the data range:", "Kutools for Excel", xTxt, , , , , 8)
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
      On Error Resume Next
      xCol.Add xCell, xCell.Text
      If Err.Number = 457 Then
        xCIndex = xCIndex + 1
        Set xCellPre = xCol(xCell.Text)
        If xCellPre.Interior.ColorIndex = xlNone Then xCellPre.Interior.ColorIndex = xCIndex
        xCell.Interior.ColorIndex = xCellPre.Interior.ColorIndex
      ElseIf Err.Number = 9 Then
        MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
        Exit Sub
      End If
      On Error GoTo 0
    Next
End Sub
Sub ColourTheRows()
    ' This colours in the rows that have the same value in column A
    Application.ScreenUpdating = False
    Dim colors As Variant, SameData As String, i As Long, j As Integer
    colors = Array(vbRed, vbGreen, vbYellow, vbBlue, vbWhite, vbMagenta, vbCyan)
    SameData = Cells(1, 1)
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        If Cells(i, 1) <> SameData Then
            j = j + 1
            SameData = Cells(i, 1)
        End If
        If j = 7 Then
            j = 0
        End If
        Rows(i).Select
        With Selection.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .Color = colors(j)
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    Next i
    Application.ScreenUpdating = True
End Sub

有关更多详细信息和替代示例，请参阅以下链接。

For more details and alternative examples, please refer links below.

如何在Excel中突出显示不同颜色的重复值？

如何使用VBA突出显示重复值

创建一个宏来改变重复行的颜色。

问候

Deepak

Deepak