| |
セル100個程度ならUnionで纏めた範囲について、MAX関数で求めればいいでしょう。
例）
Sub SampleUnion()
Dim r As Range, c As Range
Dim rRed As Range, rWhite As Range
Set r = Range("A1:A100")
For Each c In r
Select Case c.Font.Color
Case vbRed
If rRed Is Nothing Then
Set rRed = c
Else
Set rRed = Union(rRed, c)
End If
Case vbWhite
If rWhite Is Nothing Then
Set rWhite = c
Else
Set rWhite = Union(rWhite, c)
End If
End Select
Next
With WorksheetFunction
MsgBox "赤Max=" & .Max(rRed) & vbCrLf & _
"白Max=" & .Max(rWhite)
End With
End Sub
もしExcel2007なら、Font色でフィルターを掛けられますので
これを利用する手もあるでしょう。
例）
Sub SampleFilter()
Dim r As Range
Dim RedMax As Double
Dim WhiteMax As Double
Set r = Range("A1:A100")
r.Resize(1).EntireRow.Insert
With r.Offset(-1).Resize(r.Rows.Count + 1)
.Worksheet.AutoFilterMode = False
.AutoFilter Field:=1, Criteria1:=vbRed, Operator:=xlFilterFontColor
RedMax = WorksheetFunction.Subtotal(4, r)
.AutoFilter Field:=1, Criteria1:=vbWhite, Operator:=xlFilterFontColor
WhiteMax = WorksheetFunction.Subtotal(4, r)
.Worksheet.AutoFilterMode = False
.Rows(1).EntireRow.Delete xlShiftUp
End With
MsgBox "赤Max=" & RedMax & vbCrLf & _
"白Max=" & WhiteMax
End Sub
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
