Как сделать условное форматирование цветовой гаммы в VBA более эффективным способом? - PullRequest
0 голосов
/ 06 апреля 2020

Поскольку я хотел условное форматирование цветовой шкалы в диапазоне, как показано ниже, я записал макрос во время этого. Код будет работать, но я столкнулся с «процедурой большой ошибки» (ошибка компиляции), когда я делаю то же самое для 36 сводных таблиц. Так есть ли способ уменьшить размер процедуры, чтобы я мог сделать это для 60 сводных таблиц?

Тип условного форматирования, который я использовал для своей цветовой шкалы

enter image description here

enter image description here

Sub test()

    Range("B5:J12").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    Selection.FormatConditions(1).ScopeType = xlSelectionScope
End Sub

Сообщение об ошибке

enter image description here

1 Ответ

1 голос
/ 06 апреля 2020

Вам нужно извлечь код форматирования в отдельную подпрограмму и вызвать его из основного кода - не нужно повторять практически одни и те же строки снова и снова.

Например:

Sub Main()
    ApplyFC Worksheets("Sheet1").Range("B5:J12")
    ApplyFC Worksheets("Sheet2").Range("B5:J12")
    'etc etc
End Sub

Sub ApplyFC(rng As Range)

    With rng.FormatConditions.AddColorScale(ColorScaleType:=3)
        .SetFirstPriority
        .ColorScaleCriteria(1).Type = xlConditionValueLowestValue
        With .ColorScaleCriteria(1).FormatColor
            .Color = 7039480
            .TintAndShade = 0
        End With
        .ColorScaleCriteria(2).Type = xlConditionValuePercentile
        .ColorScaleCriteria(2).Value = 50
        With .ColorScaleCriteria(2).FormatColor
            .Color = 8711167
            .TintAndShade = 0
        End With
        .ColorScaleCriteria(3).Type = xlConditionValueHighestValue
        With .ColorScaleCriteria(3).FormatColor
            .Color = 8109667
            .TintAndShade = 0
        End With
        .ScopeType = xlSelectionScope
    End With

End Sub
...