Как использовать VBA для форматирования ячеек на основе значения ЛЮБОЙ из указанных ячеек? - PullRequest
1 голос
/ 08 мая 2019

Новый для VBA здесь.Я пытаюсь объединить код и избежать копирования / вставки миллион раз.В основном, если конкретные ячейки (но не смежные: например, не в столбце или диапазоне) не заполнены, то ячейки окрашиваются в цветную рамку.Когда данные вводятся в любую ячейку, эта конкретная ячейка удаляет любое форматирование.Если ячейка не отображается, форматирование возвращается.Клетки все независимы друг от друга;просто форматирование изменяемой ячейки.

Вот пример из моего избыточного кода, который работает, но может ли быть способ написать его один раз и просто определить целевые ячейки, так сказать?Поместите "H154" и "H151" и т. Д. В одну строку?

Заранее спасибо.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(False, False) = "H154" Then
    If Target.Value <> "" Then
        Target.Interior.ColorIndex = xlNone
        Target.Borders.LineStyle = xlLineStyleNone
        Else: Target.Interior.Color = RGB(226, 239, 218)
         Target.Borders.LineStyle = xlContinuous
         Target.Borders.ColorIndex = 43
    End If
 End If

  If Target.Address(False, False) = "H151" Then
    If Target.Value <> "" Then
        Target.Interior.ColorIndex = xlNone
        Target.Borders.LineStyle = xlLineStyleNone
        Else: Target.Interior.Color = RGB(226, 239, 218)
         Target.Borders.LineStyle = xlContinuous
         Target.Borders.ColorIndex = 43
    End If
 End If

If Target.Address(False, False) = "E3" Then
If Target.Value <> "" Then
Target.Interior.ColorIndex = xlNone
Target.Borders.LineStyle = xlLineStyleNone
Target.Borders.ColorIndex = xlNone
Else: Target.Interior.Color = RGB(226, 239, 218)
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 43
     End If
  End If

     If Target.Address(False, False) = "E9" Then
If Target.Value <> "" Then
Target.Interior.ColorIndex = xlNone
Target.Borders.LineStyle = xlLineStyleNone
Target.Borders.ColorIndex = xlNone
Else: Target.Interior.Color = RGB(226, 239, 218)
Target.Borders.LineStyle = xlContinuous
Target.Borders.ColorIndex = 43
     End If
  End If

1 Ответ

0 голосов
/ 09 мая 2019

Протестировано:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, c As Range, blnk As Boolean

    'any changed cells in the range of interest?
    'adjust range to suit...
    Set rng = Application.Intersect(Target, _
              Me.Range("H154,H151,E3,E9"))

    If Not rng Is Nothing Then
        'check each changed cell
        For Each c In rng
            blnk = (Len(c.Value) = 0) 'is it empty ?
            c.Interior.ColorIndex = IIf(blnk, 43, xlNone)
            c.Borders.LineStyle = IIf(blnk, xlContinuous, xlLineStyleNone)
            If blnk Then c.Borders.ColorIndex = 43
        Next c
    End If

End Sub
...