Board logo

標題: [發問] 指定區域內的最大數標示黃底色的語法。 [打印本頁]

作者: ziv976688    時間: 2019-6-9 14:20     標題: 指定區域內的最大數標示黃底色的語法。

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

[attach]30806[/attach]
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列的最大數標示黃顏色的底色。

測試檔 :
[attach]30805[/attach]
作者: n7822123    時間: 2019-6-9 18:18

本帖最後由 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

[attach]30808[/attach]
作者: ziv976688    時間: 2019-6-9 23:03

回復 2# n7822123
[attach]30811[/attach]
不好意思,以為MAX就會將所有的最大數標示黃色,所以我沒有說詳細^^"

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

回復 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

[attach]30812[/attach]
作者: ziv976688    時間: 2019-6-10 11:22

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

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

回復 4# n7822123
[attach]30834[/attach]
不好意思,剛剛才檢查到有一個計算列錯誤了 :
各區段由上往下最後一個小計是列69(第10個小計與上面的9個小計相比少跳1列),不是列70
EX : 附件的區段L欄 : P欄由上往下的10個小計列,最大數N69=71
煩請修正。謝謝你^^
作者: n7822123    時間: 2019-6-11 09:29

回復 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
作者: ziv976688    時間: 2019-6-11 10:01

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

回復 7# n7822123
[attach]30835[/attach]
謝謝修正。
但無法執行完成~會停在程式碼列14的 Stop
煩請再修正,謝謝你^^

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


作者: n7822123    時間: 2019-6-11 11:37

本帖最後由 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
作者: ziv976688    時間: 2019-6-11 16:00

回復 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個小計列^^"

煩請再修正!謝謝你!

[attach]30839[/attach]
作者: n7822123    時間: 2019-6-11 22:06

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

回復 10# ziv976688


狂汗~~~~~~為了趕上班犯了低級錯誤~

跑完一輪 a值就一直是-1了,不應該這麼寫.........

修改如下~~


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
      a = IIf(j = 10, -1, 0)
      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
作者: ziv976688    時間: 2019-6-12 00:36

回復 11# n7822123
不好意思,耽誤你去上班的時間  
答案都正確了,謝謝你的幫忙
作者: ziv976688    時間: 2019-6-14 03:23

回復 11# n7822123
n大 :
下列問題 :
http://forum.twbts.com/thread-21846-1-1.html  
4樓增修程式碼列18~列28的困擾
可否請您繼續指教?
謝謝你^^




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)