指定區域內的最大數標示黃底色的語法。 - Excel程式區

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

1^# 跳轉到 »

發表於 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

最大數標示底色.rar (14.25 KB)

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

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

2^#

發表於 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

最大數標示底色.rar (14.68 KB)

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

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

3^#

發表於 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

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

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

4^#

發表於 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

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

　暱稱: 阿龍

帖子: 406
主題: 8
精華: 0
積分: 453
點名: 0
作業系統: WINDOWS 7
軟體版本: 2007
閱讀權限: 20
性別: 男
來自: 台灣
註冊時間: 2015-2-7
最後登錄: 2021-7-31

5^#

發表於 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

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