按重复组突出显示不同颜色的行

Question

如何按重复组突出显示不同颜色的行？

我不关心本身使用了哪些颜色，我只想要重复的行一种颜色，而下一组重复另一种颜色。

例如，如果我想要'1s'绿色，'2s'蓝色等等。在我的专栏中它上升到 120。

谢谢。

Answer 1

Gowtham 的解决方案仅特定于数字并使用 VBA。您可以使用以下适用于任何类型数据且不需要 VBA 的解决方法。

我们可以使用另一列，使用公式为所有重复项生成唯一值，并为该列使用 "

Conditional Formatting

>

 Color Scales

"。截图如下。

你可以使用的公式是

"=ROW(INDEX(A$2:A$12,MATCH(A2,A$2:A$12,0)))"

在上面的公式中，A$2:A$12就是我们要搜索重复项的范围。

公式基本上搜索给定范围内重复值的第一个实例，并输入第一个实例的行号。

P.S: 在上面的公式中，范围“A$2:A$12”是一个固定范围，在表格中使用上面的公式要简单得多，因为表格范围是动态的

使用 Table 的另一个好处是我们甚至可以对数据进行排序，将重复的值组合在一起

=ROW(INDEX([Column1],MATCH(A2,[Column1],0)))

Answer 2

尝试这个简单的代码并根据您的需要进行修改。它不言自明，

Sub dupColors()
Dim i As Long, cIndex As Long
cIndex = 3
Cells(1, 1).Interior.ColorIndex = cIndex
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
    If Cells(i, 1) = Cells(i + 1, 1) Then
        Cells(i + 1, 1).Interior.ColorIndex = cIndex
    Else
        If Cells(i + 1, 1) <> "" Then
            cIndex = cIndex + 1
            Cells(i + 1, 1).Interior.ColorIndex = cIndex
        End If
    End If
Next i
End Sub

Answer 3

Gowtham 的回答很棒，如果没有他们，我不会想出下面的答案！我同样需要独特的颜色分配，但是，我需要比 colorindex 提供的 56 种颜色更多的变化，所以我稍微修改了 Gowtham 的代码，通过使用 RandBetween 和 RGB 通过随机红色创建随机颜色来提供更多变化，蓝色和绿色值。

我将颜色范围保持在 120 和 255 之间，因为一些较低的值可能会导致单元格太暗而无法阅读，但您当然可以根据自己的喜好进行自定义。下面的代码当然可以改进，因为我不是专家，但它能够获得所需的 100 多种颜色。

编辑：我要补充一点，RGB 值有可能重叠。我只需要对视觉辅助进行颜色编码；但如果您需要严格的唯一颜色值，则此代码不能保证。

Dim rCount, RandCol1, RandCol2, RandCol3, i As Long

rCount = Sheet1.Range("A" & Rows.Count).End(xlUp).Row

    For i = 1 To rCount
        If Sheet1.Cells(i, 1) = Sheet1.Cells(i + 1, 1) Then
            Sheet1.Cells(i + 1, 1).Interior.Color = RGB(RandCol1, RandCol2, RandCol3)
        Else
            If Sheet1.Cells(i + 1, 1) <> "" Then
                RandCol1 = WorksheetFunction.RandBetween(120, 255)
                RandCol2 = WorksheetFunction.RandBetween(120, 255)
                RandCol3 = WorksheetFunction.RandBetween(120, 255)
                Sheet1.Cells(i + 1, 1).Interior.Color = RGB(RandCol1, RandCol2, RandCol3)
            End If
        End If
    Next i

Answer 4

我在https://www.extendoffice.com/documents/excel/3772-excel-highlight-duplicate-values-in-different-colors.html:

中找到了这个VBA

Sub ColorCompanyDuplicates()
'Updateby Extendoffice
    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

Answer 5

找到了用于组织大量不同颜色重复项的 excel VBA 代码。

`Sub ColorCompanyDuplicates()
    'Updateby Extendoffice 20171222
    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 = Range("M10:P10010")
    If xRg Is Nothing Then Exit Sub
    xCIndex = 2
    Set xCol = New Collection
    For Each xCell In xRg
    On Error Resume Next
    If xCell.Value <> "" Then
    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.Color = RGB(xRed, xGreen, xBlue)
    xCell.Interior.Color = xCellPre.Interior.Color
    ElseIf Err.Number = 9 Then
    MsgBox "Too many duplicate companies!", vbCritical, "Kutools for Excel"
    Exit Sub
    End If
    xRed = Application.WorksheetFunction.RandBetween(0, 255)
    xGreen = Application.WorksheetFunction.RandBetween(0, 255)
    xBlue = Application.WorksheetFunction.RandBetween(0, 255)
    On Error GoTo 0
    End If
    Next
    End Sub