返回列表 上一主題 發帖

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

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

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

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

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

本帖最後由 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
程式是依需求寫的,需求表達不清楚
或者沒有上傳附件,愛莫能助

TOP

        靜思自在 : 發脾氣是短暫的發瘋。
返回列表 上一主題