Excel Условное форматирование Петля

Question

У меня есть этот код:

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF($B5=""ARC"",1,0)" 
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
With Selection.FormatConditions(1).Interior 
    .PatternColorIndex = xlAutomatic 
    .Color = ColorSheet.Range("ARC_Color").Interior.Color 
    .TintAndShade = 0 
End With 
Selection.FormatConditions(1).StopIfTrue = False 


Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF($B5=""ALL"",1,0)" 
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
With Selection.FormatConditions(1).Interior 
    .PatternColorIndex = xlAutomatic 
    .Color = ColorSheet.Range("ALL_Color").Interior.Color 
    .TintAndShade = 0 
End With 
Selection.FormatConditions(1).StopIfTrue = False 

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

=IF($B5=""ALL"",1,0) 
ColorSheet.Range("ALL_Color").Interior.Color 

что это лучший способ этого цикла? Так что у меня нет десяти блоков кода, которые точно так же?

Могу ли я изменить его, чтобы прочитать именованные диапазоны списка на отдельном листе?

Благодаря

Answer 1

Создайте процедуру, как это, что петли через диапазон на отдельном листе, под названием «Переменные» в этом примере. Диапазон содержит только 10 изменяемых значений:

EDIT: modifified per @ Исправление KillerSnail в комментариях и добавлен параметр для пропуска ColorSheet.

Sub LoopCF() 
Dim wsVariables As Excel.Worksheet 
Dim ColorSheet As Excel.Worksheet 
Dim cell As Excel.Range 

Set wsVariables = ThisWorkbook.Worksheets("Variables") 
Set ColorSheet = ActiveSheet ' Change to suit your needs 
'this range contains "All", "ARC", etc. 
For Each cell In wsVariables.Range("A2:A11") 
    ApplyCF cell.Value2 
Next cell 
End Sub 

Затем вы в основном вызываете свой существующий код из цикла, передавая «ARC», «ALL» и другие переменные.

Sub ApplyCF(wsColorSheet As Excel.Worksheet, ConditionToCheck As String) 

Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _ 
    "=IF($B5=" & Chr(34) & ConditionToCheck & Chr(34) & ",1,0)" 
Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority 
With Selection.FormatConditions(1).Interior 
    .PatternColorIndex = xlAutomatic 
    .Color = wsColorSheet.Range(ConditionToCheck & "_Color").Interior.Color 
    .TintAndShade = 0 
End With 
Selection.FormatConditions(1).StopIfTrue = False 
End Sub