Question

以下代码的工作方式是，如果用户在分数部分中输入1-5之间的数字值，则某列/每列的列将更改颜色。如果得分是1,2,3,4或5之外的任何值，则列上不会发生填充。

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

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

我似乎无法找到一种方法来使其成为分数，以确定突出显示的当前单元格是否更改为其他颜色。我希望如此，如果用户为问题2输入值3，则“Two”，“Three”和“Five”列将以黄色突出显示，但如果他们为问题1输入值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$2=$B$2:$F$6)+0,(ROW($A$2:$A$6)>0)+0)*$I$2:$I$6))=1

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

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

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

2 个答案: