特定单元格值确定列颜色 Excel答案

【问题标题】：Specific Cell Value Determines Column Colors Excel特定单元格值确定列颜色 Excel
【发布时间】：2018-07-19 07:08:11
【问题描述】：

下面的代码有效，因此如果用户在分数部分输入一个介于 1-5 之间的数值，则特定列/列组将改变颜色。如果分数是 1、2、3、4 或 5 以外的任何值，则列上不会发生填充。

假设用户为问题 2 输入值 3，“二”、“三”和“五”列将以黄色突出显示。

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

我似乎无法找到一种方法来使分数数字确定当前突出显示的单元格是否更改为不同的颜色。我想要这样，如果用户为问题 2 输入值 3，则“二”、“三”和“五”列将以黄色突出显示，但如果他们随后为问题一输入值 1 ，“一”列将以红色突出显示，“二”和“三”应保持黄色，因为分数 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

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

【问题讨论】：

你刚刚转发了这个问题吗？我感觉我之前看到过这个问题！？ >,
@CallumDA - 在这里？ - stackoverflow.com/questions/48688761/…
@CallumDA 也无法弄清楚如何使用条件格式来做到这一点（在使用 excel 或 vba 时不是很有经验）。

标签： vba excel excel-formula conditional-formatting

【解决方案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

【讨论】：

【解决方案2】：

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

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

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

我用它作为单元格K2中红色的条件格式规则：

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

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

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

【讨论】：

对不起，我对 Excel 很陌生，尤其是条件格式；所以我对如何应用这个有点困惑。
条件格式是否优先考虑最低数字（分数）？无论您输入数据的顺序是什么？如果是这样，那么是的，这就是我需要的。我尝试在空白工作表上执行您所做的操作，但无法正常工作，我不断收到错误，所以我认为我没有正确应用它。
@ColeGwozdecki 在我的示例中，单击单元格K2，单击“条件格式”，然后单击“新建规则”。然后选择“使用公式确定要格式化的单元格”并粘贴我在此公式框中提供的公式。然后选择所需的格式并单击“确定”。对 5 种颜色重复此操作（格式规则将相同，除了我在帖子中解释的最后一个字符）。然后只需使用格式刷将规则应用于您想要的任何范围。
我之前尝试过，但是在我粘贴代码并选择我的格式后它给了我同样的错误。它说：“您不得将引用运算符（例如联合、交集和范围）或数组常量用于条件格式标准。”
@ColeGwozdecki 好吧，看起来你的辅助细胞已经从我最初拥有它们的地方移走了。这没关系，但这只是意味着您必须相应地更新公式。例如。 $A$2:$A$6 需要更改为 $A$16:$A$20。这只是基于您引用 $B$16:$F$20 而不是 $B$2:$F$6 的公式的猜测。