Установить цвет ячейки на основе текущего значения

Question

Как сделать мой код короче?

Если пользователь заполняет ячейку желтым цветом, то, если его значение равно 0, оно становится красным и выдает всплывающее окно с сообщением, тогда если его значение Если> 0, он снова вернется к желтому, затем, если пользователь введет значение> 0 в ячейку «без заполнения», он станет серым и вернется к отсутствию заполнения, если я введу 0, этот код предназначен только для столбца L чтобы сделать это также для столбцов M, N и O.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Set ws = ActiveSheet
    On Error GoTo ExitSub

    'WEEK 0
    'For Task Not done
    With ws.Cells(15, 12)
        If Not (Application.Intersect(Range("L15"), Target) Is Nothing) Then
            If .Interior.ColorIndex = 6 And .Value < 1 Then  
                MsgBox "Project Delay!"
                Range("L15").Interior.ColorIndex = 3  
            Else
                If Range("L15").Interior.ColorIndex = 3 And .Value > 0 Then
                    Range("L15").Interior.ColorIndex = 6
                End If
            End If

            'For overlapped Task
            If .Interior.ColorIndex = -4142 And .Value > 0 Then
                MsgBox "Overlap!"
                Range("L15").Interior.ColorIndex = 16
            Else
                If Range("L15").Interior.ColorIndex = 16 And .Value < 1 Then
                    Range("L15").Interior.ColorIndex = -4142 
                End If
            End If
        End If
    End With

    On Error GoTo ExitSub

    'For Task Not done
    With ws.Cells(17, 12)
        If Not (Application.Intersect(Range("L17"), Target) Is Nothing) Then
            If .Interior.ColorIndex = 6 And .Value < 1 Then
                MsgBox "Project Delay!"
                Range("L17").Interior.ColorIndex = 3
            Else
                If Range("L17").Interior.ColorIndex = 3 And .Value > 0 Then
                    Range("L17").Interior.ColorIndex = 6
                End If
            End If

            'For overlapped Task
            If .Interior.ColorIndex = -4142 And .Value > 0 Then
                MsgBox "Overlap!"
                Range("L17").Interior.ColorIndex = 16
            Else
                If Range("L17").Interior.ColorIndex = 16 And .Value < 1 Then
                    Range("L17").Interior.ColorIndex = -4142
                End If
            End If
        End If
    End With
End Sub

Answer 1

Пожалуйста, попробуйте этот код. Насколько я понял ваши намерения, он должен делать то, что вы хотите.

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Tmp As Long

    With Target
        If .Cells.CountLarge > 1 Then Exit Sub
        If (.Column >= Columns("L").Column) And (.Column <= .Columns("O").Column) Then
            Tmp = Val(.Value)
            Select Case .Row
                Case 15
                    .Interior.ColorIndex = IIf(Tmp, 6, 3)
                    If Tmp = 0 Then
                        MsgBox "Project Delay!", _
                               vbCritical, "Attention required!"
                    End If
                Case 17
                    .Interior.ColorIndex = IIf(Tmp, 16, -4142)
                    If Tmp Then
                        MsgBox "Enter a value of zero.", _
                               vbExclamation, "Overlap!"
                    End If
            End Select
        End If
    End With
End Sub

Я сохранил синтаксис простым, чтобы вы могли настроить его там, где он нуждается в настройке. Удачи!