大丈夫、私はちょっとこの質問がそこに突き出ているのにうんざりしました。私はこのマクロを書きました、それは昇順でソートし、空白でない範囲を半分に切り上げ(切り上げ)、そして2つのカラースケールを適用します。必要に応じて修正してください。
Sub TestColorScale()
Application.ScreenUpdating = False
'sort ascending
With ActiveWorkbook.Worksheets("Sheet1").Sort
.SetRange Range("A:A")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'count cells
Dim intcount As Integer
Dim rngcount As Range
Set rngcount = Range("A:A")
intcount = Application.WorksheetFunction.CountA(rngcount)
rngcount.FormatConditions.Delete
'Get half
Dim inthalf As Integer
inthalf = intcount / 2
inthalf = Application.WorksheetFunction.RoundUp(inthalf, 0)
'Do first half
Dim rng1 As Range
Set rng1 = Range(Cells(1, 1), Cells(inthalf, 1))
' Add a 2-color scale.
Dim cs1 As ColorScale
Set cs1 = rng1.FormatConditions.AddColorScale(ColorScaleType:=2)
' Format the first color
With cs1.ColorScaleCriteria(1)
.Type = xlConditionValueLowestValue
With .FormatColor
.Color = vbGreen
.TintAndShade = -0.25
End With
End With
' Format the second color
With cs1.ColorScaleCriteria(2)
.Type = xlConditionValueHighestValue
With .FormatColor
.Color = vbBlue
.TintAndShade = 0
End With
End With
'Do second half
Dim rng2 As Range
Set rng2 = Range(Cells(inthalf + 1, 1), Cells(intcount, 1))
' Add a 2-color scale.
Dim cs2 As ColorScale
Set cs2 = rng2.FormatConditions.AddColorScale(ColorScaleType:=2)
' Format the third color
With cs2.ColorScaleCriteria(1)
.Type = xlConditionValueLowestValue
With .FormatColor
.Color = vbRed
.TintAndShade = -0.25
End With
End With
' Format the fourth color
With cs2.ColorScaleCriteria(2)
.Type = xlConditionValueHighestValue
With .FormatColor
.Color = vbYellow
.TintAndShade = 0
End With
End With
Application.ScreenUpdating = True
End Sub