对列中具有相同数据的行进行快速条件格式设置?

对列中具有相同数据的行进行快速条件格式设置?

我有很多数据,基本上是这样的:

Name    Data    Date        ...
Groucho 123     06/23/2018
Harpo   321     05/02/2018
Chico   1239    04/17/2018
Zeppo   2938    12/03/2018
Groucho 123098  11/27/2018
Zeppo   29381   07/03/2018
...

我希望每一行都用Name某种颜色突出显示。(如果这样更容易,我并不特别在意什么颜色)。

因此结果将如下所示:
在此处输入图片描述
(注意:可以突出显示整行,也可以只突出显示“表格”中的行。无论哪种方式都可以)

有没有更快的方法可以做到这一点?我不想输入一堆规则,例如=$A2="Groucho"设置格式,然后设置新规则=$A2="Chico",然后设置颜色等,因为我可以在 A 列中有几十个名称,并且为每个名称手动创建规则相当耗时。

我愿意接受 VBA 选项,但如果可用的话,我更喜欢内置解决方案!

答案1

这是一个 VBA 解决方案:

Sub conditional_format_by_name()
Dim rng As Range

On Error Resume Next
Set rng = Application.InputBox("Please select the range to Format", Type:=8)
On Error GoTo 0
If rng Is Nothing Then Exit Sub

rng.Select 'So the user can see the range selected, to know which column they want in the next step

Dim primaryCol As Long
primaryCol = InputBox("Now, **within that range**, which column number do you want to use as the basis for matches?")
rng.Columns(1).Select

Dim primaryList() As Variant
primaryList = rng.Columns(1).Value

Dim unique(), i As Long
unique = removeDuplicates(primaryList)
For i = LBound(unique) To UBound(unique)
    Debug.Print "Adding condition for: " & unique(i)
    rng.FormatConditions.Add Type:=xlExpression, Formula1:="=" & rng.Cells(1).Address(0) & "=""" & unique(i) & """"
    With rng.FormatConditions(1 + i).Interior
        .PatternColorIndex = xlAutomatic
        .Color = ColorRandomizer()
        .TintAndShade = 0.5
    End With
    rng.FormatConditions(1 + i).StopIfTrue = False
Next i
End Sub

Function removeDuplicates(ByVal myArray As Variant) As Variant
'https://stackoverflow.com/a/43102816/4650297
Dim d As Object
Dim v As Variant 'Value for function
Dim outputArray() As Variant
Dim i As Integer

Set d = CreateObject("Scripting.Dictionary")
For i = LBound(myArray) To UBound(myArray)
    d(myArray(i, 1)) = 1
Next i
i = 0
For Each v In d.Keys()
    ReDim Preserve outputArray(0 To i)
    outputArray(i) = v
    i = i + 1
Next v
removeDuplicates = outputArray
End Function
Function ColorRandomizer() As Long
'https://www.ozgrid.com/forum/forum/tip-tricks-code/102242-rgb-color-random
Dim i As Long, j As Long, k As Long, m As Long
Randomize
i = Int((255 * Rnd) + 1)
m = Int((255 * Rnd) + 1)
k = Int((255 * Rnd) + 1)
ColorRandomizer = RGB(i, m, k)
End Function

在此处输入图片描述

问题:每组的颜色可能彼此接近,和/或太暗而无法有效。将考虑如何解决这个问题。可能必须返回RGB值并检查我之前使用过的值,如果新值在已使用值的 25% 以内,则生成一个新数字?

相关内容