12
返回列表 上一主題 發帖

[發問] 不定區域段落的格式化語法。

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
11# 跳轉到 »
發表於 2020-12-27 15:52 | 只看該作者
本帖最後由 luhpro 於 2020-12-27 15:56 編輯
回復  luhpro
I 大 : 您好 !
感謝您的幫忙和指導
測試結果報告 :
大原則"自動分段"是OK的； ...
ziv976688 發表於 2020-12-26 16:26

晤...
Excel 2003 會有錯誤啊,
我有部分指令是透過Excel 2019 錄製巨集生再做修改的.
這裡先提供修改後支援多個五行資料的檔案, (因為不清楚你的資料是如何擴展的, 範例檔就直接把原表格左右上下拷貼增加了)
當然,應該還是會發生原先有的錯誤,
可支援2003版的檔案會晚一點,
Office不能同時裝兩套版本,
需要改去舊PC測一下.

另外,修改了一些小BUG,
還有,因為之前把舊格式全部刪掉了(包含總計),
所以再增加設定總計列格式的部分:
  1. Sub SetRng()
  2.   Dim vColor()
  3.   Dim lCol&(), lCols&, lRow&(), lRows&, lL1&, lL2&, lL3&, ll4&

  5.   vColor = Array(0, 38, 4, 8)
  6.   lL1 = 2 ' 取得五行所在欄號
  7.   lCols = Cells(lL1, Columns.Count).End(xlToLeft).Column ' 資料末欄
  8.   ReDim lCol(0) ' 陣列初始化
  9.   Do While lL1 <= lCols
  10.     ReDim Preserve lCol(UBound(lCol) + 1)
  11.     lCol(UBound(lCol)) = lL1
  12.     lL1 = Cells(1, lL1).End(xlToRight).Column  ' 找下個有資料的欄
  13.   Loop
  14.   
  15.   lL1 = 3 ' 取得小計與總計所在列號
  16.   ReDim lRow(0) ' 陣列初始化
  17.   Do While Cells(lL1, 1) <> "總計"
  18.     Do While Cells(lL1, 1) <> "小計" And Cells(lL1, 1) <> "總計"
  19.       lL1 = lL1 + 1
  20.     Loop
  21.     If Cells(lL1, 1) <> "總計" Then ' 小計所在列號
  22.       ReDim Preserve lRow(UBound(lRow) + 1)
  23.       lRow(UBound(lRow)) = lL1
  24.       lL1 = lL1 + 1
  25.     Else
  26.       lRows = lL1 ' 總計所在列號
  27.     End If
  28.   Loop
  29.   
  30.   ' ----- 清除格式設定與框線 -----
  31.   With Range(Cells(3, 2), Cells(lRows, lCols)) ' 資料範圍
  32.     .FormatConditions.Delete ' 清除所有格式規則
  33.     For lL1 = 1 To 10 ' 清除框線設定
  34.       .Borders(lL1).LineStyle = 0
  35.     Next
  36.     .Interior.Pattern = xlNone ' 清除底色
  37.   End With
  38.   
  39.   For lL1 = 2 To UBound(lCol) Step 2 ' 設定偶數段落
  40.     With Range(Cells(3, lCol(lL1)), Cells(lRows, lCol(lL1 + 1) - 1))
  41.       .Interior.ColorIndex = 34 ' 設定底色
  42.       For lL2 = 7 To 10 ' 設定外框線
  43.         With .Borders(lL2)
  44.           .LineStyle = 1
  45.           .ColorIndex = 5
  46.           .Weight = 4
  47.         End With
  48.       Next
  49.     End With
  50.   Next
  51.   
  52. On Error Resume Next ' 發生錯誤跳到下一行指令,例如超過陣列索引(最後一次時),列個數小於行個數
  53.   For lL1 = 1 To UBound(lCol) ' 設定對角區域底色
  54.     Range(Cells(lRow(lL1), lCol(lL1)), Cells(lRow(lL1), lCol(lL1 + 1) - 1)) _
  55.         .Interior.ColorIndex = 36
  56.   Next
  57.   lL1 = lL1 - 1
  58.   Range(Cells(lRow(lL1), lCol(lL1)), Cells(lRow(lL1), lCols)).Interior.ColorIndex = 36
  59. On Error GoTo 0 ' 發生錯誤中斷程式並顯示錯誤訊息
  60.   
  61.   ReDim Preserve lCol(UBound(lCol) + 1) ' 縮減程式碼,這裡做個取巧動作,配合迴圈作業
  62.   lCol(UBound(lCol)) = lCols
  63.   
  64.   ll4 = UBound(lCol) - 1 ' 減少計算次數
  65.   For lL1 = 1 To ll4 ' 小計列設定格式化公式
  66.     For lL2 = 1 To UBound(lRow)
  67.       For lL3 = 1 To 3
  68.         With Range(Cells(lRow(lL2), lCol(lL1)), Cells(lRow(lL2), _
  69.                      IIf(lL1 = ll4, lCols, lCol(lL1 + 1) - 1)))
  70.           .FormatConditions.Add Type:=xlExpression, Formula1:= _
  71.               "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & _
  72.               "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
  73.           .FormatConditions(.FormatConditions.Count).SetFirstPriority
  74.           With .FormatConditions(1).Interior
  75.             .PatternColorIndex = xlAutomatic
  76.             .ColorIndex = vColor(lL3)
  77.             .TintAndShade = 0
  78.           End With
  79.           .FormatConditions(1).StopIfTrue = True
  80.         End With
  81.       Next
  82.     Next
  83.   Next
  84.   
  85.   For lL1 = 1 To ll4 ' 總計列設定格式化公式
  86.     If lL1 = ll4 Then
  87.       lL1 = lL1
  88.     End If
  89.     For lL3 = 1 To 3
  90.       With Range(Cells(lRows, lCol(lL1)), Cells(lRows, _
  91.                    IIf(lL1 = ll4, lCols, lCol(lL1 + 1) - 1)))
  92.         .FormatConditions.Add Type:=xlExpression, Formula1:= _
  93.             "=" & Cells(lRows, lCol(lL1)).Address(0, 0) & _
  94.             "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
  95.         .FormatConditions(.FormatConditions.Count).SetFirstPriority
  96.         With .FormatConditions(1).Interior
  97.           .PatternColorIndex = xlAutomatic
  98.           .ColorIndex = vColor(lL3)
  99.           .TintAndShade = 0
  100.         End With
  101.         .FormatConditions(1).StopIfTrue = True
  102.       End With
  103.     Next
  104.   Next
  105. End Sub
複製代碼
格式化的語法-a2.zip (74.96 KB)

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
12#
發表於 2020-12-27 17:32 | 只看該作者
回復  luhpro
I 大 : 您好 !
感謝您的幫忙和指導
測試結果報告 :
大原則"自動分段"是OK的； ...
ziv976688 發表於 2020-12-26 16:26

超過30分鐘.
剛剛發現當初為了安裝Office2019有把舊PC的Office移除了, (更糟糕的是Win7還不能安裝Office2109)
現在臨時找不到當初買的包裝序號. O.O
所以只能先以 n7822123大大 提供的程式片段來修改 :
      For lL3 = 1 To 3
        With Range(Cells(lRow(lL2), lCol(lL1)), Cells(lRow(lL2), _
                     IIf(lL1 = ll4, lCols, lCol(lL1 + 1) - 1)))
          .FormatConditions.Add Type:=xlExpression, Formula1:= _
              "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & _
              "=LARGE(" & .Offset(0).Address & "," & lL3 & ")".Interior.ColorIndex = vColor(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
沒環境不能驗證,
只好請你自己試試看了......

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
13#
發表於 2020-12-27 19:48 | 只看該作者
本帖最後由 ziv976688 於 2020-12-27 19:57 編輯

回復 11# luhpro
luhpro大大 : 您好 !
除了前3大標示底色因有與2003版衝突之外，其餘測試都OK了
2003版的部分，理應由小弟自己來測試，如再有問題，我會自行修改的。
真是辛苦您了!謝謝您的無比熱心幫忙和耐心指導~小弟獲益良多~感恩*n次

TOP

luhpro

帖子
835 
主題
6 
精華
0 
積分
915 
點名
16  
作業系統
Win 10,7 
軟體版本
2019,2013,2003 
閱讀權限
50 
性別
男 
註冊時間
2010-5-3 
最後登錄
2024-11-14 
14#
發表於 2020-12-27 22:04 | 只看該作者
本帖最後由 luhpro 於 2020-12-27 22:07 編輯
回復  luhpro
luhpro大大 : 您好 !
除了前3大標示底色因有與2003版衝突之外，其餘測試都OK了
...
ziv976688 發表於 2020-12-27 19:48

抱歉,沒實測果然還是會出錯, 12#的程式有問題, 之前的程式在2003要修改一下:
          .FormatConditions.Add Type:=xlExpression, Formula1:= _
              "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & _
              "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
          .FormatConditions(lL3).Interior.ColorIndex = vColor(lL3) ' <--- 加這個

另,經測試, 設定格式時要先 Select 好作用區塊, 否則公式會是錯誤的.
再加上格式設定中畫面會亂跳,
所以我也加了 ScreenUpdating 控制,
修改後程式如下:
  1. Application.ScreenUpdating = False
  2.   ll4 = UBound(lCol) - 1 ' 減少計算次數
  3.   For lL1 = 1 To ll4 ' 小計列設定格式化公式
  4.     For lL2 = 1 To UBound(lRow)
  5.       For lL3 = 1 To 3
  6.         With Range(Cells(lRow(lL2), lCol(lL1)), Cells(lRow(lL2), _
  7.                      IIf(lL1 = ll4, lCols, lCol(lL1 + 1) - 1)))
  8.           .Select
  9.           .FormatConditions.Add Type:=xlExpression, Formula1:= _
  10.               "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & _
  11.               "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
  12.           .FormatConditions(lL3).Interior.ColorIndex = vColor(lL3)
  13.           'With .FormatConditions(1).Interior
  14.           '  .PatternColorIndex = xlAutomatic
  15.           '  .ColorIndex = vColor(lL3)
  16.           '  .TintAndShade = 0
  17.           'End With
  18.           '.FormatConditions(1).StopIfTrue = True
  19.         End With
  20.       Next
  21.     Next
  22.   Next
  23.   
  24.   For lL1 = 1 To ll4 ' 總計列設定格式化公式
  25.     If lL1 = ll4 Then
  26.       lL1 = lL1
  27.     End If
  28.     For lL3 = 1 To 3
  29.       With Range(Cells(lRows, lCol(lL1)), Cells(lRows, _
  30.                    IIf(lL1 = ll4, lCols, lCol(lL1 + 1) - 1)))
  31.         .Select
  32.         .FormatConditions.Add Type:=xlExpression, Formula1:= _
  33.             "=" & Cells(lRows, lCol(lL1)).Address(0, 0) & _
  34.             "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
  35.         .FormatConditions(lL3).Interior.ColorIndex = vColor(lL3)
  36.         'With .FormatConditions(1).Interior
  37.         '  .PatternColorIndex = xlAutomatic
  38.         '  .ColorIndex = vColor(lL3)
  39.         '  .TintAndShade = 0
  40.         'End With
  41.         '.FormatConditions(1).StopIfTrue = True
  42.       End With
  43.     Next
  44.   Next
  45. Application.ScreenUpdating = True
複製代碼
格式化的語法-a2-2003.zip (66.38 KB)

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
15#
發表於 2020-12-28 07:48 | 只看該作者
回復 14# luhpro
I大 : 早安!
前3大標示也OK了
萬分感謝您"鍥而不捨"的熱心幫忙和指導~感恩再感恩...............

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
16#
發表於 2020-12-31 00:36 | 只看該作者
本帖最後由 ziv976688 於 2020-12-31 00:41 編輯

回復 5# n7822123

測試檔 :   格式化的語法-1231-五行測試-Q.rar (32.11 KB)
n大 : 您好!
不好意思
可否請您再幫忙寫1個有起始列(EX︰191列)和迄止列(EX︰199列)~因為這個部分每個排序的起迄列之位址不一定相同~
並能依據第1列的文字自動分段畫框線和標示34號底色及總計列之前3大各標示底色的VBA(EX︰設定格式B)?
因為我沒有辦法自己以設定格式A去修改
請詳見附件A191︰AX199
謝謝您

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
17#
發表於 2020-12-31 01:09 | 只看該作者
本帖最後由 ziv976688 於 2020-12-31 01:13 編輯

不好意思，測試檔模組1的Call 設定格B，請改為設定格式B
謝謝!

TOP

n7822123
　暱稱: 阿龍

中學生Rank: 2

帖子
406 
主題
8 
精華
0 
積分
453 
點名
0  
作業系統
WINDOWS 7 
軟體版本
2007 
閱讀權限
20 
性別
男 
來自
台灣 
註冊時間
2015-2-7 
最後登錄
2021-7-31 
18#
發表於 2020-12-31 01:51 | 只看該作者
回復 17# ziv976688


改好了~也上了註解

格式化的語法-1231-五行測試-Q.rar (35.12 KB)
程式是依需求寫的，需求表達不清楚
或者沒有上傳附件，愛莫能助

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
19#
發表於 2020-12-31 03:35 | 只看該作者
本帖最後由 ziv976688 於 2020-12-31 03:46 編輯

回復 18# n7822123
n大 : 您好!
感謝您的註解，受益良多~~~
真是太厲害了，起迄列在哪裡都適用(含金彩539都可以用)，我原先還自作聰明，將 [B3].Activate改為 [B191](現在有再改回[B3])~真拙
謝謝您的快速回覆和耐心指導~感恩(鞠躬)~~~~~

TOP

        靜思自在 : 【為善競爭】人生要為善競爭，分秒必爭。
12
返回列表 上一主題