- 帖子
- 835
- 主題
- 6
- 精華
- 0
- 積分
- 915
- 點名
- 15
- 作業系統
- Win 10,7
- 軟體版本
- 2019,2013,2003
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2010-5-3
- 最後登錄
- 2024-11-12
|
6#
發表於 2020-12-26 15:15
| 只看該作者
懇請各位大大幫忙編寫1個能依"小計"和"總計"的標題自動判別段落區域範圍作格式設定的程式檔，
以利能以1款 ...
ziv976688 發表於 2020-12-25 07:31 
提供另外一個角度的寫法 :- Sub SetRng()
- Dim vColor()
- Dim lCol&(), lCols&, lRow&(), lRows&, lL1&, lL2&, lL3&
-
- ReDim lCol(5) ' 五行只有5個
- vColor = Array(0, 38, 4, 8)
- ' ----- 取得所有關鍵欄號與列號 -----
- lCol(1) = 2 ' 取得五行文字所在欄號
- For lL1 = 2 To 5
- lCol(lL1) = Cells(1, lCol(lL1 - 1) + 1).End(xlToRight).Column
- Next
- lCols = Cells(2, Columns.Count).End(xlToLeft).Column ' 在第2列找資料末欄
-
- lL1 = 3 ' 取得小計與總計所在列號
- ReDim lRow(0) ' 陣列初始化
- Do While Cells(lL1, 1) <> "總計"
- Do While Cells(lL1, 1) <> "小計" And Cells(lL1, 1) <> "總計"
- lL1 = lL1 + 1
- Loop
- If Cells(lL1, 1) <> "總計" Then ' 小計所在列號
- ReDim Preserve lRow(UBound(lRow) + 1)
- lRow(UBound(lRow)) = lL1
- lL1 = lL1 + 1
- Else
- lRows = lL1 ' 總計所在列號
- End If
- Loop
-
- ' ----- 清除格式設定與框線 -----
- With Range(Cells(3, 2), Cells(lRows, lCols)) ' 資料範圍
- .FormatConditions.Delete ' 清除所有格式規則
- For lL1 = 1 To 10 ' 清除框線設定
- .Borders(lL1).LineStyle = 0
- Next
- .Interior.Pattern = xlNone ' 清除底色
- End With
- ' ----- 開始格式設定 -----
- For lL1 = 2 To UBound(lCol) Step 2 ' 設定偶數段落
- With Range(Cells(3, lCol(lL1)), Cells(lRows, lCol(lL1 + 1) - 1))
- .Interior.ColorIndex = 34 ' 設定底色
- For lL2 = 7 To 10 ' 設定外框線
- With .Borders(lL2)
- .LineStyle = 1
- .ColorIndex = 5
- .Weight = 4
- End With
- Next
- End With
- Next
-
- For lL1 = 1 To 4 ' 設定對角區域底色
- Range(Cells(lRow(lL1), lCol(lL1)), Cells(lRow(lL1), lCol(lL1 + 1) - 1)) _
- .Interior.ColorIndex = 36
- Next
- Range(Cells(lRow(5), lCol(5)), Cells(lRow(5), lCols)).Interior.ColorIndex = 36
-
- ReDim Preserve lCol(UBound(lCol) + 1) ' 縮減程式碼,這裡做個取巧動作,配合迴圈作業
- lCol(UBound(lCol)) = lCols
-
- For lL1 = 1 To 5 ' 設定格式化公式
- For lL2 = 1 To UBound(lRow)
- For lL3 = 1 To 3
- With Range(Cells(lRow(lL2), lCol(lL1)), Cells(lRow(lL2), lCol(lL1 + 1) - 1))
- .FormatConditions.Add Type:=xlExpression, Formula1:= _
- "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
- .FormatConditions(.FormatConditions.Count).SetFirstPriority
- With .FormatConditions(1).Interior
- .PatternColorIndex = xlAutomatic
- .ColorIndex = vColor(lL3)
- .TintAndShade = 0
- End With
- .FormatConditions(1).StopIfTrue = True
- End With
- Next
- Next
- Next
- End Sub
 格式化的語法-a.zip (29.78 KB)
|
|
，請您見諒，謝謝您！
