- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2019-5-22 07:35 編輯
回復 3# ziv976688
依你檔案的程式碼所簡化的迴圈
試試看- Option Explicit
- Sub 格式化條件()
- Dim Rng As Range, AR(1 To 3) As String,i As Integer
- Set Rng = Range("B2:F2") '第一個範圍
- For i = 0 To 9 '10範圍要處裡
- With Rng
- '**Rng.Address 範圍的絕對位置 : $B2:$F2
- '**Rng(1).Address(0, 0) 範圍的第一個Cell 相對位置 B2
- ' *公式一"=(B2=MAX($B2:$F2))*(B2>0)"
- AR(1) = "=(" & Rng(1).Address(0, 0) & "=MAX(" & Rng.Address & "))*(" & Rng(1).Address(0, 0) & ">0)"
- '* 公式二"=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=2)*(B2>0)"
- AR(2) = "=(SUMPRODUCT((" & Rng(1).Address(0, 0) & "<=" & Rng.Address & ")/COUNTIF(" & Rng.Address & "," & Rng.Address & "))=2)*(" & Rng(1).Address(0, 0) & ">0)"
- '* 公式三"=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=3)*(B2>0)"
- AR(3) = "=(SUMPRODUCT((" & Rng(1).Address(0, 0) & "<=" & Rng.Address & ")/COUNTIF(" & Rng.Address & "," & Rng.Address & "))=3)*(" & Rng(1).Address(0, 0) & ">0)"
- .Select
- .FormatConditions.Delete
- .FormatConditions.Add Type:=xlExpression, Formula1:=AR(1)
- .FormatConditions(1).Interior.ColorIndex = 43
- .FormatConditions.Add Type:=xlExpression, Formula1:=AR(2)
- .FormatConditions(2).Interior.ColorIndex = 8
- .FormatConditions.Add Type:=xlExpression, Formula1:=AR(3)
- .FormatConditions(3).Interior.ColorIndex = 37
- End With
- Set Rng = Rng.Offset(, Rng.Columns.Count) '**下一個範圍
- Next
- End Sub
複製代碼 |
|