有爬文找到 : 'B71:AX71的10個各區段最數大標示底色
Set Rng = Range("B71:F71") '第一個範圍
For i = 0 To 9 '10個範圍要處裡
With Rng
' *公式一"=(B71=MAX($B71:$F71))*(B71>0)"
AR(1) = "=(" & Rng(1).Address(0, 0) & "=MAX(" & Rng.Address(0, 1) & "))*(" & Rng(1).Address(0, 0) & ">0)"
.Select
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:=AR(1)
.FormatConditions(1).Interior.ColorIndex = 38
End With
Set Rng = Rng.Offset(, Rng.Columns.Count) '**下一個範圍
If i = 8 Then Set Rng = Rng.Cells(1).Resize(, Rng.Columns.Count - 1) '最後一段(i=9)只計4欄(AU:AX)
Next 但我只要有標示底色，不要保留公式。作者: ziv976688 時間: 2019-6-13 04:42
本帖最後由 ziv976688 於 2019-6-13 04:53 編輯
經套取n7822123大大原有的程式碼~問題已解決。 謝謝!
Sub Ex()
Dim i%, j%, x%, a%, max%, rg As Range
For i = 1 To 10: x = IIf(i = 10, 4, 5)
For j = 1 To 10
a = IIf(j = 10, -1, 0)
If j = 1 Then
Set rg = Cells(7 * j, 5 * i - 3).Resize(1, x)
Else
Set rg = Union(rg, Cells(7 * j + a, 5 * i - 3).Resize(1, x))
End If
Next j
rg.Interior.Color = -1 '恢復無色
max = WorksheetFunction.max(rg)
For Each cel In rg
If cel = max Then cel.Interior.Color = RGB(255, 255, 0)
Next
Set rg = Cells(71, 5 * i - 3).Resize(1, x)
rg.Interior.Color = -1 '恢復無色
max = WorksheetFunction.max(rg)
For Each cel In rg
If cel = max Then cel.Interior.ColorIndex = 38
Next
Next i
End Sub作者: ziv976688 時間: 2019-6-13 14:53
For R = 1 To 10
a = IIf(R = 10, -1, 0)
Set rg = Cells(7 * R + a, 2).Resize(1, 49)
rg.Font.ColorIndex = 1: rg.Font.Size = 12: rg.Font.Bold = False '恢復字體格式
max = WorksheetFunction.max(rg)
For Each cel In rg
If cel = max Then cel.Font.ColorIndex = 3: cel.Font.Bold = True
Next
Next
