如何以更有效的方式在VBA中进行色标的条件格式设置？

Question

由于我想在如下所示的范围内对色标进行条件格式设置，因此我在记录宏的同时进行了记录。该代码将正常工作，但是当我对36个数据透视表执行相同操作时，我遇到了“过程较大错误”（编译错误）。那么，有没有办法减小程序的大小，以便我可以对60个可旋转对象进行操作？

我用于色标的条件格式的类型

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

错误消息

Answer 1

您需要将格式代码提取到单独的子目录中，然后从主代码中调用它-无需一遍又一遍地重复几乎相同的行。

例如：

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