Use Excel-VBA to colour a range y if value is cert

2019-08-21 18:20发布

I need to program a conditional format in Excel VBA (2016) without using the existing conditional formatting tool. As I am a newbie and tried for a while the following, I'm asking you to help me.

I want to write this e.g. in a private sub: for range E18:G18 and K1:K10:

If value is >=1 then colour = green

If value is <1 or "" then colour red

for range B1:B10

If value is >=3 then colour = green

If value is <3 & >0 then colour yellow

if value is 0 or "" the colour red

My code is the following - when i save it, nothing happens in my second defined range (K1:K10), also after reopening the excel-workbook.

Also nothing happens with my second conditional formatting range (B1:B10):

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("E18:G18, K1:K10"))

If rngObserve Is Nothing Then
    Exit Sub
End If
For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then
        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone
        ElseIf rngCell.Value < 1 Then
            rngCell.Interior.ColorIndex = 3 'red
        ElseIf rngCell.Value >= 1 Then
            rngCell.Interior.ColorIndex = 4 'green
        Else
            rngCell.Interior.ColorIndex = 3 'red
        End If
    End If
Next



Dim rngObserve As Range, rngCell As Range

Set rngObserve = Intersect(Target, Range("B1:B10"))

If rngObserve Is Nothing Then
    Exit Sub
End If
For Each rngCell In rngObserve.Cells
    If Not Intersect(rngCell, rngObserve) Is Nothing Then
        If rngCell.Value = vbNullString Then
            rngCell.Interior.Color = xlNone
        ElseIf rngCell.Value < 3 And rgncell.Value > 0 Then
            rngCell.Interior.ColorIndex = 6 'yellow
        ElseIf rngCell.Value >= 3 Then
            rngCell.Interior.ColorIndex = 4 'green
        Else
            rngCell.Interior.ColorIndex = 3 'red
        End If
    End If
Next

End Sub

标签: excel vba
1条回答
Animai°情兽
2楼-- · 2019-08-21 18:59

As mentioned in the comments, you can only have one Worksheet_Change subroutine. This code should get you what you need:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngObserve As Range, rngCell As Range

'PGCodeRider comment: I'd set these to named ranges instead of hard-coded addresses
Set rngObserve = Intersect(Target, Range("E18:G18, K1:K10"))

    If Not rngObserve Is Nothing Then

        For Each rngCell In rngObserve.Cells

    If rngCell.Value = vbNullString Then
        rngCell.Interior.Color = xlNone
    ElseIf rngCell.Value < 1 Then
        rngCell.Interior.ColorIndex = 3 'red
    ElseIf rngCell.Value >= 1 Then
        rngCell.Interior.ColorIndex = 4 'green
    Else
        rngCell.Interior.ColorIndex = 3 'red
    End If

        Next rngCell

    End If


Set rngObserve = Intersect(Target, Range("B1:B10"))

    If Not rngObserve Is Nothing Then

        For Each rngCell In rngObserve.Cells

            If rngCell.Value = vbNullString Then
                rngCell.Interior.Color = xlNone
            ElseIf rngCell.Value < 3 And rngCell.Value > 0 Then
                rngCell.Interior.ColorIndex = 6 'yellow
            ElseIf rngCell.Value >= 3 Then
                rngCell.Interior.ColorIndex = 4 'green
            Else
                rngCell.Interior.ColorIndex = 3 'red
            End If

        Next rngCell

    End If
End Sub
查看更多
登录 后发表回答