0

我想有条件地格式化一个列，每个唯一值都有自己唯一的单元格背景颜色。我运行了一个报告，我们在其中添加了一个 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

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

替换将使用类似的东西：

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 列中唯一值的条件格式。

4

2 回答 2

1

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

这应该让你开始：

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
于 2013-10-16T17:56:26.910 回答
1

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

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
于 2013-10-17T13:41:03.637 回答