VBA Excel根据唯一值将条件格式应用于单元格

Question

我想有条件地格式化一个列，每个唯一值获得自己独特的单元格背景颜色。 我运行一个报告，我们在其中添加Section Description列以进行排序。 对于视觉辅助，我希望能够为每个部分描述指定一种颜色。

流程是：

1. 运行报告
2. 部分说明已添加
3. 运行宏以指定每个部分的唯一颜色

我遇到的问题是，每次运行报告时，可能会添加不同数量的部分描述。 因此，我不知道如何在3个部分到20个部分的任何地方分配独特的颜色。

我的粗略想法如下：

（a。从A列中删除所有条件格式）

1. 查看列A（描述所在的位置）并查找所有唯一值
2. 将唯一值粘贴到单独的工作表中
3. 浏览每个唯一值并从一组颜色中指定颜色
4. 根据步骤3中的分配，将条件格式分配到主表上的A列

另一种可以做到的方法是每次在A列中更改值时运行此过程。

就色彩库而言，拥有更多中性色彩可能会很棒。 我不需要明亮的霓虹绿等。

任何帮助将不胜感激！

Sub ColorDescriptions()
'
' ColorDescriptions Macro
'
    Dim Grid As Worksheet
    Dim lastRowGridA As Long

    Set Grid = Sheets("Grid")

' get the last row from column A that has a value
    lastRowGridA = Grid.Range("A" & Grid.Rows.Count).End(xlUp).Row

' move values to STORED VALUES

    Range("A6:A" & lastRowGridA).Select
    Selection.Copy
    Sheets("STORED VALUES").Select
    Range("F2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

' remove duplicates

ActiveSheet.Range("$F$2:$F$" & lastRowGridA).RemoveDuplicates Columns:=1, Header:=xlNo
ActiveSheet.Range("A1").Select

' apply conditional formatting

Dim lastRowSVF As Long
Dim Z As Integer
Set SV = Sheets("STORED VALUES")

lastRowSVF = SV.Range("F" & SV.Rows.Count).End(xlUp).Row

Z = 2
Do
Range("G" & Z).Value = Z
Z = Z + 1
Loop Until Z = lastRowSVF + 1


End Sub

所以现在这是有效的，我得到了我所有的独特价值，我能够成功地循环，并在我到达最后一个值时停止。 下一步是更换......

Range("G" & Z).Value = Z
Z = Z + 1

...在Do之后，使用列表中的信息创建条件格式。

替换将使用如下内容：

Sheets("Grid").Select
Columns("A:A").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="='STORED VALUES'!$F$2"
' $F$2 will need to change as we loop through the list
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .PatternColorIndex = xlAutomatic
'Color will need to change as we loop through the list, I'm guessing I can use
'something like Z to define the color
    .Color = 5287936
    .TintAndShade = 0
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A1").Select
Sheets("STORED VALUES").Select
Range("F1").Select  

我想我很接近，但我只是遇到了循环问题。 一旦循环工作，我希望能够调整使用的颜色。

最终目标是在运行宏之后，我的网格表中A列中的每个值都将具有基于A列中唯一值的条件格式。

Answer 1

我决定不做渐变的事情，而是创建一个生成随机颜色值的函数。 这与Interior.ColorIndex一起使用，而不是Long颜色值。

这应该让你开始：

Sub ColorDescriptions()
    Dim Grid As Worksheet
    Dim lastRowGridA As Long
    Dim gridRange As Range
    Dim r As Range 'row iterator
    Dim dictValues As Object 'Scripting.Dictionary
    Dim dictColors As Object 'Scripting.Dictionary

    Set Grid = Sheets(2)
    Set dictValues = CreateObject("Scripting.Dictionary")
    Set dictColors = CreateObject("Scripting.Dictionary")
    Set gridRange = Grid.UsedRange.Columns("A:A")
    'I use a scripting dictionary since it only allows unique keys:
    For Each r In gridRange.Cells
        If Not dictValues.Exists(r.Value) Then
            'This dictionary stores what color to use for each key value
            dictValues(r.Value) = intRndColor(dictColors)
            dictColors(dictValues(r.Value) = ""
        End If

        If dictColors.Count <= 56 Then
            r.Interior.ColorIndex = dictValues(r.Value)
        Else:
            MsgBox "Too many unique values to use only 56 color palette"

        End If
    Next
' apply conditional formatting

''' the rest of your code/

End Sub

'modified from
' http://www.ozgrid.com/forum/showthread.php?t=85809
Function intRndColor(dict)
     'USE - FUNCTION TO PICK RANDOM COLOR, ALSO ALLOWS EXCLUSION OF COLORS YOU DON'T LIKE
    Dim Again As Label
Again:
    intRndColor = Int((50 * Rnd) + 1) 'GENERATE RANDOM IN

    If dict.Exists(intRndColor) Then GoTo Again

    Select Case intRndColor
    Case Is = 0, 1, 3, 21, 35, 36 'COLORS YOU DON'T WANT; Modify as needed
        GoTo Again
    End Select

End Function

Answer 2

感谢大卫的帮助。 我最终通过找到我喜欢的颜色并确保我只使用这些颜色来解决我的问题。 我尝试分配随机颜色，但这是不可行的。 此方法只需几种颜色，并通过我的描述符分配它们。

Sub ColorDescriptions()
'
' ColorDescriptions Macro
'
' Turn Screen flashing off

Application.ScreenUpdating = False


Dim Grid As Worksheet
Dim lastRowGridA As Long

Set Grid = Sheets("Grid")

Sheets("Grid").Select

'Sort everything by Section Description

Rows("5:5").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Grid").AutoFilter.Sort.SortFields.Add Key:=Range( _
    "A5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
    xlSortNormal
With ActiveWorkbook.Worksheets("Grid").AutoFilter.Sort
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With
Selection.AutoFilter


' get the last row from column A that has a value
lastRowGridA = Grid.Range("A" & Grid.Rows.Count).End(xlUp).Row

' move values to STORED VALUES
Sheets("Grid").Select
Range("A6:A" & lastRowGridA).Select
Selection.Copy
Sheets("STORED VALUES").Select
Range("F2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Application.CutCopyMode = False

' remove duplicates

ActiveSheet.Range("$F$2:$F$" & lastRowGridA).RemoveDuplicates Columns:=1, Header:=xlNo
ActiveSheet.Range("A1").Select

' apply conditional formatting

Dim lastRowSVF As Long
Dim Z As Integer
Dim A As Integer
Dim B As Integer

Set SV = Sheets("STORED VALUES")

lastRowSVF = SV.Range("F" & SV.Rows.Count).End(xlUp).Row

Z = 2
A = 11
B = 12

Do

If (Z Mod 8) + 2 = 2 Then
D = A
ElseIf (Z Mod 8) + 2 = 3 Then
D = B
Else: D = (Z Mod 8) + 2
End If

Sheets("Grid").Select
Columns("A:A").Select
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
    Formula1:="='STORED VALUES'!$F$" & Z
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
With Selection.FormatConditions(1).Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .PatternTintAndShade = 0
    .ThemeColor = xlThemeColorAccent & D
    .TintAndShade = 0.6
End With
Selection.FormatConditions(1).StopIfTrue = False
Range("A1").Select
Sheets("STORED VALUES").Select

'This next section is used to document the colors being assigned and the method

Range("G" & Z).Value = Z
Range("H" & Z).Value = "xlThemeColorAccent" & D
Range("I" & Z).Select
With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .ThemeColor = xlThemeColorAccent & D
    .TintAndShade = 0.6
    .PatternTintAndShade = 0
End With

Z = Z + 1
Loop Until Z = lastRowSVF + 1


End Sub