复现Excel红黄绿三色刻度条件格式逻辑的技术问询

Let's fix your code to match Excel's native color scale and smooth out the color transitions properly. Here's a step-by-step solution:

1. Get Excel's Exact Color Scale RGB Values #

First, we need to pull the precise RGB values Excel uses for its built-in red-yellow-green color scale (the second option in the color scale menu). Run this quick sub to get the exact values:

Sub GetNativeColorScaleRGB()
    Dim tempRange As Range
    Set tempRange = ThisWorkbook.ActiveSheet.Range("A1") ' Use any empty cell
    
    ' Apply Excel's 3-color scale (second preset)
    tempRange.FormatConditions.AddColorScale ColorScaleType:=3
    With tempRange.FormatConditions(1)
        ' Extract RGB for each color stop
        Debug.Print "Low (Red) Color: RGB(" & _
            .ColorScaleCriteria(1).Color Mod 256 & ", " & _
            (.ColorScaleCriteria(1).Color \ 256) Mod 256 & ", " & _
            .ColorScaleCriteria(1).Color \ 65536 & ")"
            
        Debug.Print "Mid (Yellow) Color: RGB(" & _
            .ColorScaleCriteria(2).Color Mod 256 & ", " & _
            (.ColorScaleCriteria(2).Color \ 256) Mod 256 & ", " & _
            .ColorScaleCriteria(2).Color \ 65536 & ")"
            
        Debug.Print "High (Green) Color: RGB(" & _
            .ColorScaleCriteria(3).Color Mod 256 & ", " & _
            (.ColorScaleCriteria(3).Color \ 256) Mod 256 & ", " & _
            .ColorScaleCriteria(3).Color \ 65536 & ")"
    End With
    
    ' Clean up temporary formatting
    tempRange.FormatConditions.Delete
End Sub

When you run this, check the Immediate Window (Ctrl+G in the VBA Editor) for the exact RGB values. For most Excel versions, these are typically:

• Low (Red): RGB(255, 199, 206)
• Mid (Yellow): RGB(255, 235, 156)
• High (Green): RGB(198, 239, 206)

2. Updated VBA Code with Native Color Matching & Smooth Transitions #

The main issues with your original code were fixed blue channel values, linear-only transitions causing uneven visual changes, and incorrect target RGB values. Below is the revised code that addresses all these:

Sub ExcelTricolorScale(Rng As Range)
    Dim cl As Range
    Dim dMax As Double, dMin As Double, dMed As Double
    Dim ratio As Double
    
    ' --- Define Excel's native color scale RGB values (replace with your extracted values) ---
    Const RGB_LOW_R As Integer = 255
    Const RGB_LOW_G As Integer = 199
    Const RGB_LOW_B As Integer = 206
    
    Const RGB_MID_R As Integer = 255
    Const RGB_MID_G As Integer = 235
    Const RGB_MID_B As Integer = 156
    
    Const RGB_HIGH_R As Integer = 198
    Const RGB_HIGH_G As Integer = 239
    Const RGB_HIGH_B As Integer = 206
    
    ' --- Optional: Gamma correction to smooth transitions (0.5 = slower at extremes, faster in middle) ---
    Const GAMMA As Double = 0.5
    
    ' Get range stats
    dMax = WorksheetFunction.Max(Rng)
    dMin = WorksheetFunction.Min(Rng)
    dMed = WorksheetFunction.Median(Rng)
    
    ' Exit if all values are the same
    If dMax = dMin Then
        Rng.Interior.Color = RGB(RGB_MID_R, RGB_MID_G, RGB_MID_B)
        Exit Sub
    End If
    
    For Each cl In Rng
        If IsNumeric(cl.Value) Then
            ' Calculate ratio relative to median
            If cl.Value <= dMed Then
                ratio = (cl.Value - dMin) / (dMed - dMin)
                ' Apply gamma correction to adjust transition speed
                ratio = ratio ^ GAMMA
                
                ' Interpolate each RGB channel from LOW to MID
                cl.Interior.Color = RGB( _
                    RGB_LOW_R + ratio * (RGB_MID_R - RGB_LOW_R), _
                    RGB_LOW_G + ratio * (RGB_MID_G - RGB_LOW_G), _
                    RGB_LOW_B + ratio * (RGB_MID_B - RGB_LOW_B) _
                )
            Else
                ratio = (cl.Value - dMed) / (dMax - dMed)
                ' Apply gamma correction
                ratio = ratio ^ GAMMA
                
                ' Interpolate each RGB channel from MID to HIGH
                cl.Interior.Color = RGB( _
                    RGB_MID_R + ratio * (RGB_HIGH_R - RGB_MID_R), _
                    RGB_MID_G + ratio * (RGB_HIGH_G - RGB_MID_G), _
                    RGB_MID_B + ratio * (RGB_HIGH_B - RGB_MID_B) _
                )
            End If
        Else
            ' Non-numeric cells: clear fill
            cl.Interior.ColorIndex = xlColorIndexNone
        End If
    Next cl
End Sub

3. Key Improvements Explained #

• Native Color Matching: Uses the exact RGB values pulled from Excel's built-in scale, so colors will match perfectly.
• Full RGB Interpolation: All three red, green, and blue channels are interpolated, not just red and green like your original code.
• Gamma Correction: The GAMMA constant lets you tweak transition speed:
  • GAMMA = 1 = linear transitions (matches Excel's native behavior)
  • GAMMA < 1 = slower color changes near min/max, faster around the median (fixes your "extremes change too fast" issue)
  • GAMMA > 1 = faster changes near extremes, slower around median (reverse effect)
• Error Handling: Skips non-numeric cells and handles cases where all values are identical.

4. Testing the Code #

• Replace the RGB constants with the values you extracted from GetNativeColorScaleRGB to ensure perfect color matching.
• Adjust the GAMMA value to tweak the transition feel until it fits your preference. For visual smoothness, 0.5 or 0.7 works great to reduce the abrupt "jump" near extremes.

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