1

У меня много данных, в основном так:

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 ответ1

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

Проблемы: цвета для каждой группы могут быть близки друг к другу и / или быть слишком темными, чтобы быть эффективными. Буду думать о том, как обойти это. Возможно, придется вернуть значения R , G и B и проверить те, которые я использовал ранее, и если новые значения находятся в пределах, скажем, 25% от уже использованного значения, сгенерировать новое число?

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .