使用带有六个条件的图标集的条件格式

我正在使用条件格式，我已经玩了几天的条件格式，但我无法得到我正在寻找的回应。

我想要一个彩色的圆形出现在单元格基于input的标记。 但问题是我有六个条件，但Excel只支持五个我认为。 这可能吗？

0-20 red color circle 21-39 green color circle 40-54 blue color circle 55-64 yellow color circle 65-79 orange color circle 80-100 pink color circle 

Answer 1

如果仅限于使用图标集的条件格式规则：

• 如果你不需要圈子的话，你的6条规则可以很容易的设置成如下图所示

• 如果在CF规则中需要超过4个彩色圆圈： 创build您自己的Excel图标集

如果您可以使用VBA，下面的代码将创build类似于本机CF界的程式化的圆圈

• 打开VBA： Alt + F11
• 创build一个新的模块：菜单项插入 > 模块并粘贴代码
• 点击第一个子testIcons()内的任意位置，然后按F5运行它

---

 Option Explicit Public Sub testIcons() Application.ScreenUpdating = False setIcon Sheet1.UsedRange Application.ScreenUpdating = True End Sub Public Sub setIcon(ByRef rng As Range) Dim cel As Range, sh As Shape, adr As String For Each sh In rng.Parent.Shapes If InStrB(sh.Name, "$") > 0 Then sh.Delete Next: DoEvents For Each cel In rng If Not IsError(cel.Value2) Then If Val(cel.Value2) > 0 And Not IsDate(cel) Then adr = cel.Address Set sh = Sheet1.Shapes.AddShape(msoShapeOval, cel.Left + 5, cel.Top + 2, 10, 10) sh.ShapeStyle = msoShapeStylePreset38: sh.Name = adr sh.Fill.ForeColor.RGB = getCelColor(Val(cel.Value2)) sh.Fill.Solid End If End If Next End Sub Public Function getCelColor(ByRef celVal As Long) As Long Select Case True Case celVal < 21: getCelColor = RGB(222, 0, 0): Exit Function Case celVal < 40: getCelColor = RGB(0, 111, 0): Exit Function Case celVal < 55: getCelColor = RGB(0, 0, 255): Exit Function Case celVal < 64: getCelColor = RGB(200, 200, 0): Exit Function Case celVal < 80: getCelColor = RGB(200, 100, 0): Exit Function Case celVal <= 100: getCelColor = RGB(200, 0, 200): Exit Function End Select End Function 

---

---

注意 ：

• VBA代码应该使用小数据
• 它可以产生大量的形状，这将使所有其他操作变慢

大约1000行20列的testing：总圈数19,250 ; 持续时间： 47.921875秒

---

编辑 ：做了2更新sub setIcon()

1. 自洁

2. 如果单元格不包含错误，则仅处理数字值

   • 它排除了包含文本，空单元格或date的单元格
   • 感谢您的build议@EEM

Answer 2

你可以用VBA做。

安装程序，绘制一个椭圆形状，并向下拖动单元格复制它。 一旦完成，那么你可以input值或公式。

一旦你运行代码的形状将改变颜色。

代码

 Sub Button1_Click() Dim sh As Shape Dim I As Integer Dim r As String, rng As Range I = 1 For Each sh In ActiveSheet.Shapes If sh.Name = "Oval " & I Then r = sh.TopLeftCell.Address 'find the range of the button clicked. Set rng = Range(r) Select Case rng Case Is < 21 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = 255 Case Is < 40 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = 5287936 Case Is < 55 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = 12611584 Case Is < 65 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = 65535 Case Is < 80 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = RGB(255, 153, 51) Case Is < 101 ActiveSheet.Shapes(sh.Name).Fill.ForeColor.RGB = RGB(255, 153, 204) Case Else End Select I = I + 1 End If Next End Sub 

示例工作簿

Answer 3

VBA是我知道这样做的唯一方法。 如果你可以应付整个细胞被着色，那么这可能适合你：

 Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Finish Application.EnableEvents = False If Target.Count > 1 Then GoTo Finish If Target.Value = "" Then Target.Interior.Color = -4142 ' no colour GoTo Finish ElseIf Target.Value < 21 Then Target.Interior.ColorIndex = 3 'red GoTo Finish ElseIf Target.Value < 40 Then Target.Interior.ColorIndex = 10 'green GoTo Finish ElseIf Target.Value < 55 Then Target.Interior.ColorIndex = 23 'blue GoTo Finish ElseIf Target.Value < 65 Then Target.Interior.ColorIndex = 6 'yellow GoTo Finish ElseIf Target.Value < 80 Then Target.Interior.ColorIndex = 45 'orange GoTo Finish ElseIf Target.Value < 101 Then Target.Interior.ColorIndex = 7 ' pink Else Target.ColorIndex = -4142 End If Finish: Application.EnableEvents = True End Sub 

当您更改工作表中的单元格的值时，将会运行。 因为我懒惰（在编码方面相当平庸），它只会在你每次更新一个单元时工作，而且它正在整个工作表上运行。 但它会给你一个起点工作。