特定单元格值决定列颜色 Excel

Question

下面的代码有效，因此如果用户在分数部分输入 1-5 之间的数值，特定列/列组将改变颜色。如果 Score 不是 1、2、3、4 或 5，则不会在列上进行填充。

假设用户为问题 2 输入值 3，则 "Two"、"Three" 和 "Five" 列将以黄色突出显示。

现在，如果用户为问题一输入值 1，则列 "One"、"Two" 和 "Three" 将以红色突出显示。列 "Five" 仍将保持黄色，但 "Two" 和 "Three"（因为分组与问题重叠）变为红色，因为这是最近发生的事件。

我似乎想不出一种方法来让分数决定当前突出显示的单元格是否更改为不同的颜色。我想要它，所以如果用户为问题 2 输入值 3，则 "Two"、"Three" 和 "Five" 列将以黄色突出显示，但如果他们随后输入问题一的值为 1，列 "One" 将以红色突出显示，而 "Two" 和 "Three" 应保持黄色，因为分数 3 高于 1。

问题一按列分组：一、二、三

问题二按列分组：二、三、五

问题三按列分组：三、四

问题四按列分组：三、四

问题五按列分组：一、二、三

得分 1 显示：红色

得分 2 显示：橙色

分数 3 显示：黄色

得分 4 显示：浅绿色

得分 5 显示：深绿色

Private Sub CheckBox1_Click()

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("D19")) Is Nothing Then
        Select Case Range("D19").Value
            Case 1
                Range("L3:N28").Interior.ColorIndex = 3
            Case 2
                Range("L3:N28").Interior.ColorIndex = 45
            Case 3
                Range("L3:N28").Interior.ColorIndex = 6
            Case 4
                Range("L3:N28").Interior.ColorIndex = 4
            Case 5
                Range("L3:N28").Interior.ColorIndex = 50
            Case Else
            Range("L3:N28").Interior.ColorIndex = 0
        End Select
    End If

    If Not Intersect(Target, Range("D20")) Is Nothing Then
        Select Case Range("D20").Value
            Case 1
                Range("M3:N28,P3:P28").Interior.ColorIndex = 3
            Case 2
                Range("M3:N28,P3:P28").Interior.ColorIndex = 45
            Case 3
                Range("M3:N28,P3:P28").Interior.ColorIndex = 6
            Case 4
                Range("M3:N28,P3:P28").Interior.ColorIndex = 4
            Case 5
                Range("M3:N28,P3:P28").Interior.ColorIndex = 50
            Case Else
            Range("M3:N28,P3:P28").Interior.ColorIndex = 0
        End Select
    End If

    If Not Intersect(Target, Range("D21")) Is Nothing Then
        Select Case Range("D21").Value
            Case 1
                Range("N3:O28").Interior.ColorIndex = 3
            Case 2
                Range("N3:O28").Interior.ColorIndex = 45
            Case 3
                Range("N3:O28").Interior.ColorIndex = 6
            Case 4
                Range("N3:O28").Interior.ColorIndex = 4
            Case 5
                Range("N3:O28").Interior.ColorIndex = 50
            Case Else
            Range("N3:O28").Interior.ColorIndex = 0
        End Select
    End If

    If Not Intersect(Target, Range("D22")) Is Nothing Then
        Select Case Range("D22").Value
            Case 1
                Range("N3:O28").Interior.ColorIndex = 3
            Case 2
                Range("N3:O28").Interior.ColorIndex = 45
            Case 3
                Range("N3:O28").Interior.ColorIndex = 6
            Case 4
                Range("N3:O28").Interior.ColorIndex = 4
            Case 5
                Range("N3:O28").Interior.ColorIndex = 50
            Case Else
            Range("N3:O28").Interior.ColorIndex = 0
        End Select
    End If

    If Not Intersect(Target, Range("D23")) Is Nothing Then
        Select Case Range("D23").Value
            Case 1
                Range("L3:N28").Interior.ColorIndex = 3
            Case 2
                Range("L3:N28").Interior.ColorIndex = 45
            Case 3
                Range("L3:N28").Interior.ColorIndex = 6
            Case 4
                Range("L3:N28").Interior.ColorIndex = 4
            Case 5
                Range("L3:N28").Interior.ColorIndex = 50
            Case Else
            Range("L3:N28").Interior.ColorIndex = 0
        End Select
    End If
End Sub

我希望我能正确地解释自己。有什么帮助，谢谢。

Answer 1

下面的代码比较所有可能的答案组合，而不考虑它们的顺序

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.CountLarge > 1 Then Exit Sub

    Const U1 = 19    'User input row 1
    Const U2 = 20
    Const U3 = 21
    Const U4 = 22
    Const U5 = 23
    Const D = 4      'User input column

    Dim r As Long, v As Long, fnd As Range
    r = Target.Row
    v = Val(Target.Value2)

    With Target.Parent

        Set fnd = .UsedRange.Find("One")    'find first question
        If Target.Column <> D Or r < U1 Or r > U5 Or v > 5 Or fnd Is Nothing Then Exit Sub

        Dim fr As Long, lr As Long, fc As Long
        fr = fnd.Row + 1                'first used row
        lr = .UsedRange.Rows.Count      'last used row
        fc = fnd.Column                 'last used column

        Dim a1 As Long, a2 As Long, a3 As Long, a4 As Long, a5 As Long
        a1 = Val(.Cells(U1, D).Value2)  'answer 1
        a2 = Val(.Cells(U2, D).Value2)
        a3 = Val(.Cells(U3, D).Value2)
        a4 = Val(.Cells(U4, D).Value2)
        a5 = Val(.Cells(U5, D).Value2)

        Dim c1 As Range, c2 As Range, c3 As Range, c4 As Range, c5 As Range
        Set c1 = .Range(.Cells(fr, fc + 0), .Cells(lr, fc + 0)) 'column 1
        Set c2 = .Range(.Cells(fr, fc + 1), .Cells(lr, fc + 1))
        Set c3 = .Range(.Cells(fr, fc + 2), .Cells(lr, fc + 2))
        Set c4 = .Range(.Cells(fr, fc + 3), .Cells(lr, fc + 3))
        Set c5 = .Range(.Cells(fr, fc + 4), .Cells(lr, fc + 4))

        Dim qCols As Range, clr As Long
        Select Case r
            Case U1
                Set qCols = Union(c1, c2, c3)   'question 1
                Select Case True
                    Case v < a3 Or v < a4:  Set qCols = Union(c1, c2)
                    Case v < a2:            Set qCols = c1
                End Select
            Case U2
                Set qCols = Union(c2, c3, c5)   'question 2
                Select Case True
                    Case v < a3 Or v < a4:  Set qCols = Union(c2, c5)
                    Case v < a1:            Set qCols = c5
                End Select
            Case U3
                Set qCols = Union(c3, c4)       'question 3
                Select Case True
                    Case v < a1 Or v < a2:  Set qCols = c4
                    Case v < a5:            Set qCols = c3
                End Select
            Case U4
                Set qCols = Union(c3, c4)       'question 4
                If v < a2 Or v < a5 Then Set qCols = c4
            Case U5
                Set qCols = Union(c1, c2, c3)   'question 5
                Select Case True
                    Case v < a3 Or v < a4:              Set qCols = Union(c1, c2)
                    Case v < a2 And (v < a3 Or v < a4): Set qCols = c1
                End Select
        End Select

        clr = RGB(255, 255, 255)
        Select Case v   'set colors based on current cell's value
            Case 1: clr = RGB(255, 0, 0)    'red
            Case 2: clr = RGB(255, 111, 0)  'orange
            Case 3: clr = RGB(255, 255, 0)  'yellow
            Case 4: clr = RGB(0, 255, 0)    'light green
            Case 5: clr = RGB(0, 111, 0)    'dark green
        End Select

        If v < 1 Then
          .UsedRange.Interior.Pattern = xlNone  'if cell value <1 clear all colors
        Else
          If Not qCols Is Nothing Then qCols.Interior.Color = clr
        End If
    End With
End Sub

Answer 2

你可以试试这个（没有VBA的解决方案）：

我在这个解决方案中使用了辅助列，尽管您可以将所有内容都硬编码到公式中，如果您真的愿意，可以避免使用辅助列，这只会使公式变得超长。

编辑 - 只记得条件格式不允许硬编码，所以在这种情况下实际上辅助单元格是你唯一的选择。

我将其用作单元格 K2:

中红色的条件格式设置规则

= MAX((MMULT((K=$B:$F)+0,(ROW($A:$A)>0)+0)*$I:$I))=1

除最后一个字符外，其他条件格式规则相同。例如，橙色规则的末尾是 =2 而不是 =1.

范围与您的不同，因此您必须更改范围，但公式有效。请参阅下面的几个示例。

特定单元格值决定列颜色 Excel

Specific Cell Value Determines Column Colors Excel

excel

vba

conditional-formatting

excel-formula