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

I'm using Conditional Formatting, I've been playing around with Conditional Formatting for a couple of days but I can't get the response I'm looking for.

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

I'm wanting a colored circle to appear in cell based on the marks entered. But the problem is I have six conditions but Excel supports only five I think. Is this possible?

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

3 个解决方案

#1

If you are limited to Conditional Formatting rules with Icon Sets:

如果您受限于图标集的条件格式规则:

and if you don't have to have circles, your 6 rules can be easily set up as in the image bellow

如果您不必拥有圆圈,则可以轻松设置您的6条规则,如下图所示
if you need more than 4 colored circles in CF rules: Create Your Own Excel Icon Set

如果CF规则中需要4个以上的彩色圆圈:创建自己的Excel图标集

If you can use VBA, the code bellow will create stylized circles similar to native CF circles

如果你可以使用VBA,下面的代码将创建类似于原生CF圈的风格化圆圈

Open VBA: Alt + F11

打开VBA:Alt + F11

Create a new module: menu item Insert > Module and paste the code

创建一个新模块:菜单项Insert> Module并粘贴代码

Click anywhere inside the first sub testIcons() and press F5 to run it

单击第一个子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

Note:

The VBA code should be used with small data

VBA代码应与小数据一起使用

It can generates a large number of shapes which will make all other operations slow

它可以生成大量的形状,这将使所有其他操作变慢

A test with approx 1,000 rows and 20 cols: Total circles 19,250; duration: 47.921875 seconds

大约1,000行和20列的测试:总圈数19,250;持续时间:47.921875秒

Edit: made 2 updates to sub setIcon()

编辑:对sub setIcon()进行了2次更新

Self-cleaning
If the cell doesn't contain an error, it processes numeric values only

如果单元格不包含错误,则仅处理数值
- It excludes cells with text, empty cells, or dates
- Thanks for the suggestion @EEM

#2

You can do it with VBA.

你可以用VBA做到这一点。

The Setup, draw an oval shape and drag the cell down to copy it. Once done, then you can enter the values or the formulas.

设置,绘制椭圆形状并向下拖动单元格进行复制。完成后,您可以输入值或公式。

Once you run the code the shapes will change color.

运行代码后,形状将改变颜色。

The Code

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

Sample Workbook

#3

VBA is the only way I know of doing this. If you can cope with the whole cell being coloured then this might work for you:

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

This will run when ever you change the value of a cell in the worksheet. Because I'm lazy (and pretty mediocre at coding) it will only work when you update a single cell at a time, and it is running on the entire work sheet. But it will give you a starting point to work from.

当您更改工作表中单元格的值时,这将运行。因为我很懒(而且在编码方面相当平庸),它只会在你一次更新一个单元格时运行,并且它在整个工作表上运行。但它会为你提供一个起点。

#1