Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

15492 / 76734

←次へ　｜　前へ→


	【66719】Re:違う文字色それぞれの最高値

teian - 10/9/29(水) 17:15 -


	引用なし

	パスワード

セル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

2 hits

▼

【66713】違う文字色それぞれの最高値 Yuki 10/9/28(火) 18:13