返回列表 上一主題 發帖

[發問] 指定區域內的最大數標示黃底色的語法。

[發問] 指定區域內的最大數標示黃底色的語法。

本帖最後由 ziv976688 於 2019-6-9 14:22 編輯

未命名.png
2019-6-9 14:19

10個區段︰從第7列的B欄(含)開始,5欄*9(=到AT欄)+AU︰AX(4欄)
各區段的10列(=各小計列)範圍︰從第7列(含)開始,每跳過6列*9(=到第63列)+跳過5列=69列

請問︰上述各區段的10列範圍內的最大數標示黃底色的格式設定語法?   謝謝!

詳細的各區域範圍如下︰
Range($B7:$F7,$B14:$F14,$B21:$F21,$B28:$F28,$B35:$F35,$B42:$F42,$B49:$F49,$B56:$F56,$B63:$F63,$B69:$F69)等5欄*10列的最大數標示黃顏色的底色。
Range($G7:$K7,$G14:$K14,$G21:$K21,$G28:$K28,$G35:$K35,$G42:$K42,$G49:$K49,$G56:$K56,$G63:$K63,$G69:$K69)等5欄*10列的最大數標示黃顏色的底色。
Range($L7:$P7,$L14:$P14,$L21:$P21,$L28:$P28,$L35:$P35,$L42:$P42,$L49:$P49,$L56:$P56,$L63:$P63,$L69:$P69)等5欄*10列的最大數標示黃顏色的底色。
Range($Q7:$U7,$Q14:$U14,$Q21:$U21,$Q28:$U28,$Q35:$U35,$Q42:$U42,$Q49:$U49,$Q56:$U56,$Q63:$U63,$Q69:$U69)等5欄*10列的最大數標示黃顏色的底色。
Range($V7:$Z7,$V14:$Z14,$V21:$Z21,$V28:$Z28,$V35:$Z35,$V42:$Z42,$V49:$Z49,$V56:$Z56,$V63:$Z63,$V69:$Z69)等5欄*10列的最大數標示黃顏色的底色。
Range($AA7:$AE7,$AA14:$AE14,$AA21:$AE21,$AA28:$AE28,$AA35:$AE35,$AA42:$AE42,$AA49:$AE49,$AA56:$AE56,$AA63:$AE63,$AA69:$AE69)等5欄*10列的最大數標示黃顏色的底色。
Range($AF7:$AJ7,$AF14:$AJ14,$AF21:$AJ21,$AF28:$AJ28,$AF35:$AJ35,$AF42:$AJ42,$AF49:$AJ49,$AF56:$AJ56,$AF63:$AJ63,$AF69:$AJ69)等5欄*10列的最大數標示黃顏色的底色。
Range($AK7:$AO7,$AK14:$AO14,$AK21:$AO21,$AK28:$AO28,$AK35:$AO35,$AK42:$AO42,$AK49:$AO49,$AK56:$AO56,$AK63:$AO63,$AK69:$AO69)等5欄*10列的最大數標示黃顏色的底色。
Range($AP7:$AT7,$AP14:$AT14,$AP21:$AT21,$AP28:$AT28,$AP35:$AT35,$AP42:$AT42,$AP49:$AT49,$AP56:$AT56,$AP63:$AT63,$AP69:$AT69)等5欄*10列的最大數標示黃顏色的底色。
Range($AU7:$AX7,$AU14:$AX14,$AU21:$AX21,$AU28:$AX28,$AU35:$AX35,$AU42:$AX42,$AU49:$AX49,$AU56:$AX56,$AU63:$AX63,$AU69:$AX69)等4欄*10列的最大數標示黃顏色的底色。

測試檔 :
最大數標示底色.rar (10.6 KB)

本帖最後由 n7822123 於 2019-6-9 18:33 編輯

回復 1# ziv976688

試試看!

Sub Ex()
Dim i%, j%, x%, max%,rg As Range
For i = 1 To 10: x = IIf(i = 10, 4, 5)
  For j = 1 To 10
      If j = 1 Then
        Set rg = Cells(7 * j, 5 * i - 3).Resize(1, x)
      Else
        Set rg = Union(rg, Cells(7 * j, 5 * i - 3).Resize(1, x))
      End If
    Next j
    rg.Interior.Color = -1  '恢復無色
    Max = WorksheetFunction.Max(rg)
    For Each cel In rg
      If cel = Max Then
        cel.Interior.Color = RGB(255, 255, 0): Exit For
      End If
   Next
Next i
End Sub

最大數標示底色.rar (14.25 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 2# n7822123
未命名.png
2019-6-9 23:03

不好意思,以為MAX就會將所有的最大數標示黃色,所以我沒有說詳細^^"

煩請你再修正 :
如果最大數有2個(含)以上的相同數字,則全部都標示黃色==>EX : L欄 : P欄段的最大數有M42=69和N63=69,則將2個最大數的儲存格都標示黃色。
謝謝你 !

TOP

回復 3# ziv976688


Exit for 拿掉就行了~

Sub Ex()
Dim i%, j%, x%, max%, rg As Range
For i = 1 To 10: x = IIf(i = 10, 4, 5)
  For j = 1 To 10
      If j = 1 Then
        Set rg = Cells(7 * j, 5 * i - 3).Resize(1, x)
      Else
        Set rg = Union(rg, Cells(7 * j, 5 * i - 3).Resize(1, x))
      End If
    Next j
    rg.Interior.Color = -1  '恢復無色
    max = WorksheetFunction.max(rg)
    For Each cel In rg
      If cel = max Then cel.Interior.Color = RGB(255, 255, 0)
   Next
Next i
End Sub

最大數標示底色.rar (14.68 KB)
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 4# n7822123
我真是LOW,多麻煩你一次,很不好意思^^'
沒有問題了,謝謝你!
===================
http://forum.twbts.com/thread-21839-1-1.html
這一題,可否再請你幫忙?
謝謝你!

TOP

本帖最後由 ziv976688 於 2019-6-11 06:30 編輯

回復 4# n7822123
最大數標示底色_Ans.rar (14.92 KB)
不好意思,剛剛才檢查到有一個計算列錯誤了 :
各區段由上往下最後一個小計是列69(第10個小計與上面的9個小計相比少跳1列),不是列70
EX : 附件的區段L欄 : P欄由上往下的10個小計列,最大數N69=71
煩請修正。謝謝你^^

TOP

回復 6# ziv976688


恩 沒注意到你最後一列的列數 不太一樣
修改紅色的地方如下

Sub Ex()
Dim i%, j%, x%, a%, max%, rg As Range
For i = 1 To 10: x = IIf(i = 10, 4, 5)
  
  For j = 1 To 10
      If j = 10 Then a = -1
      If j = 1 Then
        Set rg = Cells(7 * j, 5 * i - 3).Resize(1, x)
      Else
        Set rg = Union(rg, Cells(7 * j + a, 5 * i - 3).Resize(1, x))
      End If
    Next j
   
    If i = 1 Then Stop
    rg.Select
    rg.Interior.Color = -1  '恢復無色
    max = WorksheetFunction.max(rg)
    For Each cel In rg
      If cel = max Then cel.Interior.Color = RGB(255, 255, 0)
   Next

Next i
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

本帖最後由 ziv976688 於 2019-6-11 10:13 編輯

回復 7# n7822123
未命名.png
2019-6-11 10:01

謝謝修正。
但無法執行完成~會停在程式碼列14的 Stop
煩請再修正,謝謝你^^

PS : 不懂為什麼要  If i = 1 Then Stop
        而讓程式執行停在列14

TOP

本帖最後由 n7822123 於 2019-6-11 11:44 編輯

回復 8# ziv976688


咦~~~~deubg用的...忘記刪除了...........

這兩行程式請刪掉~~~XD

If i = 1 Then Stop
rg.Select


完整程式如下

Sub Ex()
Dim i%, j%, x%, a%, max%, rg As Range
For i = 1 To 10: x = IIf(i = 10, 4, 5)
  For j = 1 To 10
      If j = 10 Then a = -1
      If j = 1 Then
        Set rg = Cells(7 * j, 5 * i - 3).Resize(1, x)
      Else
        Set rg = Union(rg, Cells(7 * j + a, 5 * i - 3).Resize(1, x))
      End If
    Next j
    rg.Interior.Color = -1  '恢復無色
    max = WorksheetFunction.max(rg)
    For Each cel In rg
      If cel = max Then cel.Interior.Color = RGB(255, 255, 0)
   Next
Next i
End Sub
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

回復 9# n7822123
不好意思,好像比對的範圍亂掉了,答案錯更多^^"
10個小計列=7,14,21,28,35,42,49,56,63,69

6樓的檔案的10個小計列=7,14,21,28,35,42,49,56,63,70
只差將最後一個小計列70,改為69列即可。

9樓程式碼的10個小計列,執行後答案很亂,好像不止10個小計列^^"

煩請再修正!謝謝你!

0611測試檔.rar (29.92 KB)

TOP

        靜思自在 : 謊言像一朵盛開的鮮花,外表美麗,生命短暫。
返回列表 上一主題