Используйте Excel-VBA, чтобы закрасить диапазон y, если задано значение определенного числа, И цветовой диапазон x, если задано значение определенного числа.

Question

Мне нужно запрограммировать условный формат в Excel VBA (2016) без использования существующего инструмента условного форматирования.Поскольку я новичок и некоторое время пробовал следующее, я прошу вас помочь мне.

Я хочу написать это, например, в частном сабвуфере: для диапазона E18: G18 и K1: K10:

Если значение>> 1, то цвет = зеленый

Если значение <1 или "", то цвет красный </p>

для диапазона B1: B10

Если значение>> 3, то цвет = зеленый

Если значение <3 &> 0, тогда цвет желтый

, если значение равно 0 или "" цветкрасный

Мой код следующий: когда я сохраняю его, во втором определенном диапазоне (K1: K10) ничего не происходит, даже после повторного открытия книги Excel.

Также ничегопроисходит с моим вторым диапазоном условного форматирования (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

Answer 1

Как уже упоминалось в комментариях, у вас может быть только одна подпрограмма Worksheet_Change.Этот код должен получить то, что вам нужно:

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