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 質問
【66715】Re:違う文字色それぞれの最高値 Abebobo 10/9/29(水) 10:48 発言
【66719】Re:違う文字色それぞれの最高値 teian 10/9/29(水) 17:15 発言

15492 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free