Excel表格红-黄-绿-黄-红颜色刻度条件格式VBA宏实现问题

需求：给表格中的工时数据应用颜色刻度条件格式，规则如下：

• 0到7.5小时区间：颜色从红渐变到黄再到绿
• 超过7.5小时区间：颜色从绿渐变到黄再到红

目前遇到的问题：编写的宏要么仅对单个单元格生效，要么只能实现红→绿→红的线性渐变效果，无法达到预期的分段渐变需求。

现有单个单元格生效代码 #

Sub HourColorsShortOneCell()
    Dim rg, cl As Range
    Dim col, row As Integer
    Dim cs As ColorScale
 
    Set rg = Selection

    If rg.Value < 3.75 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "0"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 0, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "3.75"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
    ElseIf rg.Value >= 3.75 And rg.Value <= 11.25 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "3.75"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "7.5"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(0, 255, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(3).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(3).Value = "11.25"
            cs.ColorScaleCriteria(3).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(3).FormatColor.TintAndShade = 0
    ElseIf rg.Value > 11.25 Then
        Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
            cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(1).Value = "11.25"
            cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 255, 0)
            cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
            cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
            cs.ColorScaleCriteria(2).Value = "15"
            cs.ColorScaleCriteria(2).FormatColor.Color = RGB(255, 0, 0)
            cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
    End If

End Sub

现有红→绿→红效果代码 #

Sub HourColorsShort()
    Dim rg, cl As Range
    Dim col, row As Integer
    Dim cs As ColorScale
 
    Set rg = Selection


    Set cs = rg.FormatConditions.AddColorScale(ColorScaleType:=3)
        cs.ColorScaleCriteria(1).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(1).Value = "0"
        cs.ColorScaleCriteria(1).FormatColor.Color = RGB(255, 0, 0)
        cs.ColorScaleCriteria(1).FormatColor.TintAndShade = 0
        cs.ColorScaleCriteria(2).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(2).Value = "7.5"
        cs.ColorScaleCriteria(2).FormatColor.Color = RGB(0, 255, 0)
        cs.ColorScaleCriteria(2).FormatColor.TintAndShade = 0
        cs.ColorScaleCriteria(3).Type = xlConditionValueFormula
        cs.ColorScaleCriteria(3).Value = "15"
        cs.ColorScaleCriteria(3).FormatColor.Color = RGB(255, 0, 0)
        cs.ColorScaleCriteria(3).FormatColor.TintAndShade = 0


End Sub

当前效果说明：执行上述第二个代码后，颜色渐变是红→绿→红，不符合分段渐变的需求。

注：已修正代码中的颜色设置。

内容的提问来源于stack exchange，提问作者ghost022