返回列表 上一主題 發帖

[發問] 請簡化錄製的程式碼。

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2019-5-21 05:40 | 顯示全部帖子

[發問] 請簡化錄製的程式碼。

測試檔 : 格式化條件公式.rar (7.64 KB)

以下是B2︰F2,G2︰K2,......, AU2︰AX2格式化條件公式錄製的程式碼︰
    Range("B2:F2").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(B2=MAX($B2:$F2))*(B2>0)"
    Selection.FormatConditions(1).Interior.ColorIndex = 43
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=2)*(B2>0)"
    Selection.FormatConditions(2).Interior.ColorIndex = 8
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((B2<=$B2:$F2)/COUNTIF($B2:$F2,$B2:$F2))=3)*(B2>0)"
    Selection.FormatConditions(3).Interior.ColorIndex = 37
   
    Range("G2:K2").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(G2=MAX($G2:$K2))*(G2>0)"
    Selection.FormatConditions(1).Interior.ColorIndex = 43
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((G2<=$G2:$K2)/COUNTIF($G2:$K2,$G2:$K2))=2)*(G2>0)"
    Selection.FormatConditions(2).Interior.ColorIndex = 8
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((G2<=$G2:$K2)/COUNTIF($G2:$K2,$G2:$K2))=3)*(G2>0)"
    Selection.FormatConditions(3).Interior.ColorIndex = 37
︰
︰
    Range("AU2:AX2").Select
    Selection.FormatConditions.Delete
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(AU2=MAX($AU2:$AX2))*(AU2>0)"
    Selection.FormatConditions(1).Interior.ColorIndex = 43
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((AU2<=$AU2:$AX2)/COUNTIF($AU2:$AX2,$AU2:$AX2))=2)*(AU2>0)"
    Selection.FormatConditions(2).Interior.ColorIndex = 8
    Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
        "=(SUMPRODUCT((AU2<=$AU2:$AX2)/COUNTIF($AU2:$AX2,$AU2:$AX2))=3)*(AU2>0)"
    Selection.FormatConditions(3).Interior.ColorIndex = 37

共10段(請詳見測試檔)

請問︰可以再簡化嗎?

PS︰
公式要保留。
如果只能一段一段改，就請只改一段就可以了，其它9段我再套寫就好!

謝謝幫忙!
收藏 分享

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
2#
發表於 2019-5-21 12:24 | 顯示全部帖子
回復 2# Scott090
例如  Range("B2:F2") 中的
            條件   1. 最大數的底色是 ....43號底色
            條件   2. 次大 .... 底色是 ....8號底色
            條件   3. ........37號底色
            假如數字一樣大 ? ....同樣底色。EX :有二個或三個同是最大時，則都標示43號底色；有二個或三個同是次大時，則都標示8號底色；有二個或三個同是三大時，則都標示37號底色。

    以上供參 !謝謝你 !

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
3#
發表於 2019-5-21 19:50 | 顯示全部帖子
回復 4# GBKEE
感謝解答。
請再修正最後一段(第10段)$AU : $AX2  ->只有4欄
除了 For i = 0 To 9 改成= 0 To 8
請問 : 第9段要怎麼補寫?

還有直執行後的公式的"列位"多了絕對符號 " $ " ->EX : $B2 : $F2變成 $B$2 : $F$2 ；$G2 : $K2變成 $G$2 : $K$2；.......
所以無法再複製格式到其它列。
請問 : 要如何修改?

以上請你修正。謝謝你^^

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
4#
發表於 2019-5-21 19:56 | 顯示全部帖子
回復 5# Scott090
感謝解答。
執行後，前三大的(中式排名)底色標示正確，但公式不見了^^"
所以無法再作複製格式到其它列之用。
請你修正為能將公式保留。謝謝你^^

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
5#
發表於 2019-5-22 00:35 | 顯示全部帖子
本帖最後由 ziv976688 於 2019-5-22 00:36 編輯

回復 8# Scott090
不好意思，我在發問時，就有特別註明"公式要保留"~可能你沒有注意到
還是非常感謝你一再的幫忙

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
6#
發表於 2019-5-22 07:12 | 顯示全部帖子
本帖最後由 ziv976688 於 2019-5-22 07:23 編輯

回復 4# GBKEE
有筆誤~重新回覆和說明。

感謝解答。
請再修正最後一段(第10段)$AU2 : $AX2  ->只有4欄；不是$AU2 : AY2
除了 For i = 0 To 9 改成= 0 To 8
請問 : 第10段要怎麼補寫?

還有執行後的公式的"列位"多了絕對符號 " $ " ->EX : $B2 : $F2變成 $B$2 : $F$2 ；$G2 : $K2變成 $G$2 : $K$2；.......；$AP2 : $AT2變成$AP$2 : $AT$2；$AU2 : $AX2變成$AU$2 : $AX$2
所以無法再用"大掃把"複製格式到其它列。
請問 : 要如何修改?

以上  煩請你修正。謝謝你^^

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
7#
發表於 2019-5-22 15:47 | 顯示全部帖子
回復 11# GBKEE

完成了!
感謝你的指教和幫忙

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
8#
發表於 2019-5-24 14:56 | 顯示全部帖子
回復 11# GBKEE
格式化條件公式_G大.rar (8.95 KB)

列25          Set Rng = Rng.Offset(, IIf(i < 9, Rng.Columns.Count, Rng.Columns.Count - 1)) '**下一個範圍

不好意思，今天要使用，不知道為什麼還是多了一欄(AY2)^^"
可否請你再指正?謝謝你!

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
9#
發表於 2019-5-24 19:36 | 顯示全部帖子
回復 14# GBKEE

Set Rng = Rng.Offset(, IIf(i < 9, Rng.Columns.Count, Rng.Columns.Count - 1))  '**下一個範圍
和
Set Rng = Rng.Offset(, IIf(i < 8, Rng.Columns.Count, Rng.Columns.Count - 1))  '**下一個範圍
二段成式碼都是計算到多1欄(AY欄)；
以For i = 0 To 9 來說
應該是i < 9才是正確的
只是不知是甚麼原故，.Columns.Count - 1無效。
甚至改為.Columns.Count - 2還是計算到AY欄。
煩請再指正!謝謝你!

TOP

ziv976688

帖子
678 
主題
147 
精華
0 
積分
799 
點名
0  
作業系統
win 8 
軟體版本
MS 2003 
閱讀權限
50 
性別
男 
註冊時間
2016-2-9 
最後登錄
2022-1-20 
10#
發表於 2019-5-25 14:05 | 顯示全部帖子
本帖最後由 ziv976688 於 2019-5-25 14:15 編輯

回復 16# GBKEE

你太客氣了^^
不論過程，只論結果~有了最後正確的結果，我都是心存感激的。

再將絕對位址Rng.Address 改成絕對欄位址Rng.Address(0, 1)
完成了!
感謝你的耐心指導和幫忙

TOP

        靜思自在 : 地上種了菜，就不易長草；心中有善，就不易生惡。
返回列表 上一主題