Есть ли способ, которым я могу применить этот код к нескольким строкам, не дублируя его для каждой строки?

Question

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

У меня есть код, который работает для выполнения этой функции, но мне интересно, есть ли какие-нибудь эксперты, которые могут настроить код для просмотра ряда различных строк и выполнять одну и ту же операцию в каждой строке, без мне приходится дублировать код сотни раз и просто менять диапазоны.

Таким образом, вы можете увидеть из моего кода ниже, что если E10 равен "Y", то он закрашивает диапазон ячеек в строке 10 "No Fill". Возможно ли, чтобы код выполнял ту же операцию в строке 11 с ячейкой E11 и в строке 12 с ячейкой E12 и т. Д.

Код будет запускаться при нажатии кнопки.

Идея состоит в том, что если человек помечен как «Y» в поле, то его ряд закрашен белым, чтобы можно было планировать задачи в его ряду.

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

Sub Shade1()
'
' Shade1 Macro
'

'
If Range("E10").Value = "Y" Then

Range("W10:AG10,AK10:BB10").Select
Range("AK10").Activate
With Selection.Interior
    .Pattern = xlNone
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With
End If
End Sub

Было бы здорово, если бы кто-нибудь из вас мог помочь! Приветствия

Скриншот листа

Answer 1

вы можете использовать Автофильтр () и избегать циклов:

Sub Shade1()
    With Range("E8", Cells(Rows.Count, 5).End(xlUp)) ' reference column "E" cells from row 8 (header) down to last not empty one
        .AutoFilter field:=1, Criteria1:="Y" ' filter referenced range with "Y" content
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then ' if any filtered cell other then header
            With Intersect(.Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow, Range("W:AG,AK:BB")).Interior ' reference intersection bewtween filtered range rows and columns W to AG and AK to BB
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
        .Parent.AutoFilterMode = False 'remove filtering
    End With
End Sub

Answer 2

Используйте цикл как:

Sub Shade1()
'
    Dim s1 As String, s2 As String

    s1 = "E10"
    s2 = "W10:AG10,AK10:BB10"

    For i = 10 To 9999
        t1 = Replace(s1, "10", i)
        t2 = Replace(s2, "10", i)
        If Range(t1).Value = "Y" Then
            With Range(t2).Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next i
End Sub

Сделайте 9999 все, что вам нужно, чтобы покрыть все ваши данные.
Нет необходимости Select или Activate.