返回列表 上一主題 發帖

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

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

本帖最後由 ziv976688 於 2020-12-25 07:35 編輯

懇請各位大大幫忙編寫1個能依"小計"和"總計"的標題自動判別段落區域範圍作格式設定的程式檔,
以利能以1款式的程式碼即可完成執行各種排序段落的格式需求。
謝謝 !

需求︰
A_指定區域標示粗框線和底色
1_請將偶數段落(以B欄段落起算)由A3到總計列(位址不定)各標示5號粗框線和34號底色。
2_請將對角區域的小計列段落標示36號底色。

B_指定區域的前3大值標示底色
1_請將各"小計"列和"總計"列的各區域段落之前3大值(可重複)各標示38,4,8號底色。

詳如範例檔︰ 格式化的語法.rar (13.4 KB)
未命名.png
2020-12-25 07:29

回復 1# ziv976688


有上註解,不過應該還是不太好懂

執行完VBA 可以按 "Ctrl + G" 查看格式化條件的設定內容

讓你方便快速查看,不用一個個點進去,以後你也好自己修改

檔案如下,試試看~


格式化的語法-1226.rar (21.28 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 2# n7822123

修改一下防呆程式(有找到範圍才執行),避免跳錯誤

格式化的語法-1226.rar (21.65 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 3# n7822123
n大 : 早安 !
測試成功~太棒了 ! 終於完成適用全部不同欄位區域段落格式檔案的需求。
尤其貴程式碼有加上註解,讓我更容易了解程式碼的意義,有利於日後萬一有需求變更,可自行修改~
謝謝您的熱心幫忙和指導~感恩喔

TOP

回復 4# ziv976688


寫的比較匆忙,有地方沒改到,請修改以下程式

公式1 = "=(" & 第一格 & "=MAX(" & 公式範圍 & "))*(B11>=0)"

改為

公式1 = "=(" & 第一格 & "=MAX(" & 公式範圍 & "))*(" & 第一格 & ">=0)"

這樣才完全符合你原本的範例公式
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

懇請各位大大幫忙編寫1個能依"小計"和"總計"的標題自動判別段落區域範圍作格式設定的程式檔,
以利能以1款 ...
ziv976688 發表於 2020-12-25 07:31

提供另外一個角度的寫法 :
  1. Sub SetRng()
  2.   Dim vColor()
  3.   Dim lCol&(), lCols&, lRow&(), lRows&, lL1&, lL2&, lL3&
  4.   
  5.   ReDim lCol(5) ' 五行只有5個
  6.   vColor = Array(0, 38, 4, 8)
  7.   ' ----- 取得所有關鍵欄號與列號 -----
  8.   lCol(1) = 2 ' 取得五行文字所在欄號
  9.   For lL1 = 2 To 5
  10.     lCol(lL1) = Cells(1, lCol(lL1 - 1) + 1).End(xlToRight).Column
  11.   Next
  12.   lCols = Cells(2, Columns.Count).End(xlToLeft).Column ' 在第2列找資料末欄
  13.   
  14.   lL1 = 3 ' 取得小計與總計所在列號
  15.   ReDim lRow(0) ' 陣列初始化
  16.   Do While Cells(lL1, 1) <> "總計"
  17.     Do While Cells(lL1, 1) <> "小計" And Cells(lL1, 1) <> "總計"
  18.       lL1 = lL1 + 1
  19.     Loop
  20.     If Cells(lL1, 1) <> "總計" Then ' 小計所在列號
  21.       ReDim Preserve lRow(UBound(lRow) + 1)
  22.       lRow(UBound(lRow)) = lL1
  23.       lL1 = lL1 + 1
  24.     Else
  25.       lRows = lL1 ' 總計所在列號
  26.     End If
  27.   Loop
  28.   
  29.   ' ----- 清除格式設定與框線 -----
  30.   With Range(Cells(3, 2), Cells(lRows, lCols)) ' 資料範圍
  31.     .FormatConditions.Delete ' 清除所有格式規則
  32.     For lL1 = 1 To 10 ' 清除框線設定
  33.       .Borders(lL1).LineStyle = 0
  34.     Next
  35.     .Interior.Pattern = xlNone ' 清除底色
  36.   End With

  37.     ' ----- 開始格式設定 -----
  38.   For lL1 = 2 To UBound(lCol) Step 2 ' 設定偶數段落
  39.     With Range(Cells(3, lCol(lL1)), Cells(lRows, lCol(lL1 + 1) - 1))
  40.       .Interior.ColorIndex = 34 ' 設定底色
  41.       For lL2 = 7 To 10 ' 設定外框線
  42.         With .Borders(lL2)
  43.           .LineStyle = 1
  44.           .ColorIndex = 5
  45.           .Weight = 4
  46.         End With
  47.       Next
  48.     End With
  49.   Next
  50.   
  51.   For lL1 = 1 To 4 ' 設定對角區域底色
  52.     Range(Cells(lRow(lL1), lCol(lL1)), Cells(lRow(lL1), lCol(lL1 + 1) - 1)) _
  53.          .Interior.ColorIndex = 36
  54.   Next
  55.   Range(Cells(lRow(5), lCol(5)), Cells(lRow(5), lCols)).Interior.ColorIndex = 36
  56.   
  57.   ReDim Preserve lCol(UBound(lCol) + 1) ' 縮減程式碼,這裡做個取巧動作,配合迴圈作業
  58.   lCol(UBound(lCol)) = lCols
  59.   
  60.   For lL1 = 1 To 5 ' 設定格式化公式
  61.     For lL2 = 1 To UBound(lRow)
  62.       For lL3 = 1 To 3
  63.         With Range(Cells(lRow(lL2), lCol(lL1)), Cells(lRow(lL2), lCol(lL1 + 1) - 1))
  64.           .FormatConditions.Add Type:=xlExpression, Formula1:= _
  65.           "=" & Cells(lRow(lL2), lCol(lL1)).Address(0, 0) & "=LARGE(" & .Offset(0).Address & "," & lL3 & ")"
  66.           .FormatConditions(.FormatConditions.Count).SetFirstPriority
  67.           With .FormatConditions(1).Interior
  68.             .PatternColorIndex = xlAutomatic
  69.             .ColorIndex = vColor(lL3)
  70.             .TintAndShade = 0
  71.           End With
  72.           .FormatConditions(1).StopIfTrue = True
  73.         End With
  74.       Next
  75.     Next
  76.   Next
  77. End Sub
複製代碼
格式化的語法-a.zip (29.78 KB)

TOP

回復 5# n7822123
n大 :
有測試生肖的規格格式,3樓的答案也是正確的
謝謝您耐心的再作更精準的修正。
已依照貴見修改好了~感激不盡
未命名.png
2020-12-26 15:46

1226-格式化的語法.rar (43.93 KB)

TOP

本帖最後由 ziv976688 於 2020-12-26 16:43 編輯

回復 6# luhpro
I 大 : 您好 !
感謝您的幫忙和指導
測試結果報告 :
大原則"自動分段"是OK的;
只是有些"非爾因素"影響到正確的答案~
1_前3大的底色標示無法顯示~跳出錯誤438(物件不支援此屬性或方法)。
不好意思,可能是因受到我的Excel為2003版所致。
2_分隔段落只限於5個。
不好意思,因為我的文字說明只以一句"自動判別段落區域範圍"帶過,並沒有特別註明有很多種的段落區域,以致讓您誤會只有5段的一種區域範圍~尚請您見諒

PS: 
我是有買2016版的Excel,但將2003版改成2016版,常會產生偵錯或甚至無法開啟檔案; 
因為經年累積的檔案甚多,無法一一修改,只好以2003版續用 ,請您見諒,謝謝您!

未命名.png
2020-12-26 16:25

格式化的語法-l大.rar (33.6 KB)

TOP

回復 7# ziv976688


    如果你的資料格式變化再大一點,第一格就不一定是B11了,修正後程式彈性會好一點
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 9# n7822123
n大 :您好!.
哈~您誤解我的意思了~
我是說 : 如果您不提,我根本不知道3樓的貴解尚有可精進的地方
再次謝謝您的熱心指導和幫忙

TOP

        靜思自在 : 為人處世要小心細心,但不要「小心眼」。
返回列表 上一主題