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

我正在使用条件格式，我已经玩了几天的条件格式，但我无法得到我想要的响应

我希望根据输入的标记在单元格中显示一个彩色圆圈。但问题是我有六个条件，而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

---

您可以使用VBA来完成

在设置中，绘制一个椭圆形并向下拖动单元格以复制它。完成后，您可以输入值或公式

运行代码后，形状将更改颜色

代码

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

子按钮1\u单击（）
像形状一样暗淡
作为整数的Dim I
尺寸r作为字符串，rng作为范围
I=1
对于ActiveSheet.Shapes中的每个sh
如果sh.Name=“Oval”&I则
r=sh.TopLeftCell.Address'查找所单击按钮的范围。
设置rng=范围（r）
选择案例rng
病例<21例
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=255
病例<40
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=5287936
病例<55例
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=12611584
例<65
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=65535
例<80
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=RGB（255,153,51）
病例<101
ActiveSheet.Shapes（sh.Name）.Fill.ForeColor.RGB=RGB（255、153、204）
其他情况
结束选择
I=I+1
如果结束
下一个
端接头

---

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

Private子工作表\u更改（ByVal目标作为范围）
错误转到完成时
Application.EnableEvents=False
如果Target.Count>1，则转到Finish
如果Target.Value=”“，则
Target.Interior.Color=-4142'无颜色
转到终点
如果目标值小于21，则
Target.Interior.ColorIndex=3'红色
转到终点
ElseIf目标值<40则
Target.Interior.ColorIndex=10'绿色
转到终点
ElseIf目标值<55则
Target.Interior.ColorIndex=23'蓝色
转到终点
ElseIf目标值<65然后
Target.Interior.ColorIndex=6'黄色
转到终点
ElseIf目标值<80则
Target.Interior.ColorIndex=45'橙色
转到终点
ElseIf目标值<101然后
Target.Interior.ColorIndex=7'粉红色
其他的
Target.ColorIndex=-4142
如果结束
完成：Application.EnableEvents=True
端接头

---

当您更改工作表中单元格的值时，将运行此操作。因为我很懒（而且在编码方面也相当平庸），所以它只能在每次更新一个单元格时工作，并且它会在整个工作表上运行。但它将为您提供一个工作起点。

如果您仅限于具有图标集的条件格式规则：

• 如果你不必有圆圈，你的6条规则可以很容易地设置，如下图所示

• 如果在CF规则中需要4个以上的彩色圆圈：

如果可以使用VBA，下面的代码将创建类似于本机CF圆的样式化圆

• 打开VBA:Alt+F11
• 创建新模块：菜单项插入模块并粘贴代码
• 单击第一个子菜单中的任意位置

  testIcons（）

  ，然后按F5运行它

---

选项显式
公开次级证言（）
Application.ScreenUpdating=False
setIcon Sheet1.UsedRange
Application.ScreenUpdating=True
端接头
公共子设置图标（ByRef rng As范围）
尺寸cel为范围，sh为形状，adr为字符串
对于rng.Parent.Shapes中的每个sh
如果InStrB（sh.Name，“$”）大于0，则sh.Delete
下一个：DoEvents
对于rng中的每个cel
如果不是IsError（单元值2），则
如果Val（cel.Value2）>0且不是IsDate（cel），则
adr=小区地址
设置sh=Sheet1.Shapes.AddShape（msoShapeOval，单元格左侧+5，单元格顶部+2,10,10）
sh.ShapeStyle=msoShapeStylePreset38:sh.Name=adr
sh.Fill.ForeColor.RGB=getCelColor（Val（cel.Value2））
sh.Fill.Solid
如果结束
如果结束
下一个
端接头
公共函数getCelColor（ByRef celVal作为Long）作为Long
选择Case True
Case celVal<21:getCelColor=RGB（222,0,0）：退出函数
Case celVal<40:getCelColor=RGB（0,111,0）：退出函数
Case celVal<55:getCelColor=RGB（0,0,255）：退出函数
Case celVal<64:getCelColor=RGB（200,200,0）：退出函数
Case celVal<80:getCelColor=RGB（200,100,0）：退出功能
Case celVal@pnuts是的。同一个单元格。我对VBA不熟悉。我使用了条件格式菜单。我读了这篇文章，但找不到任何解决方案。这是一个很好的问题，但如果使用一些样本数据以及行和列引用，甚至是显示行和列标签的预期结果的图像，很容易成为一个很好的问题。如何克服空单元格？我更新了它以排除空单元格（工作表上还有其他形状吗？还有其他对象吗？）Sara I做了一个重要的更新：请更新代码并再次运行它以清理任何以前的圆-此版本刷新所有圆并删除任何先前存在的圆（自清理）很好的整理方法。我不想开始复制旧的XL2007错误，该错误将CF规则拆分并堆叠在一起。嗨@paulbica–我的意思是一个具有非数值的单元格。您的代码只检查
If Len（cel.Value2）处的单元格是否为空>0则
，因此如果单元格值为非数字，则符合条件，因此当代码稍后使用单元格值检索要应用于
sh.Fill.ForeColor.RGB=getCelColor（Val（cel.value））的颜色时
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