Блог

Мне удалось собрать несколько строк вместе, но поскольку я новичок в VBA, и поскольку мне нужно еще 95 строк, мой код смехотворно длинный. Мне действительно нужна помощь, чтобы сократить его. Однако мои реальные проблемы заключаются в следующем:

1. Я хочу, чтобы рабочая книга обновлялась при изменении любого цвета заливки в столбце B. (Excel, похоже, не регистрирует изменение цвета как изменение.)
2. Если дата в строке 2 (которая содержит даты в течение 366 дней, необязательно, начиная с 1 января) является первым днем месяца, тогда я хочу черную левую границу в том же столбце от строки 4 до строки 103. Пример: если L2 соответствует 1 февраля 2022 года, то диапазон L4: L103 имеет левую черную рамку. Я знаю, что могу сделать это с помощью условного форматирования, но тогда мне приходится использовать тот же условный формат в 366 столбцах, что делает мою книгу довольно тяжелой.

Для визуализации см. Это изображение:

Мой код каменного века:

 Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, r1 As Range, r2 As Range, r3 As Range

Set r1 = Range("G4:NF4")
Set r2 = Range("G5:NF5")
Set r3 = Range("G6:NF6")
 

и т. Д. … и затем…

 For Each c In r1
    If c.Offset(-2, 0).Value >= Range("E4").Value And c.Offset(-2, 0).Value <= Range("F4") Then
    If Range("B4").Interior.Color < 0 Then
    c.Interior.ColorIndex = 15
    Else
        c.Interior.Color = Range("B4").Interior.Color
    Else
        c.Interior.ColorIndex = 15
    End If
Next c

For Each c In r2
    If c.Offset(-3, 0).Value >= Range("E5").Value And c.Offset(-3, 0).Value <= Range("F5") Then
    If Range("B5").Interior.Color < 0 Then
    c.Interior.ColorIndex = 15
    Else
        c.Interior.Color = Range("B5").Interior.Color
    Else
        c.Interior.ColorIndex = 15
    End If
Next c

For Each c In r3
    If c.Offset(-4, 0).Value >= Range("E6").Value And c.Offset(-4, 0).Value <= Range("F6") Then
    If Range("B6").Interior.Color < 0 Then
    c.Interior.ColorIndex = 15
    Else
        c.Interior.Color = Range("B6").Interior.Color
    Else
        c.Interior.ColorIndex = 15
    End If
Next c
 

и т.д…

 End Sub