Excel VBA質問箱 IV

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

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


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

75267 / 76738

←次へ　｜　前へ→


	【5913】Re:特定の列の最大値Cellに色を塗りたい

takumama - 03/6/7(土) 22:41 -


	引用なし

	パスワード

こんばんわ。
とりあえず、InputBoxで入力して処理を選択するように修正してみました。
改良の余地はいっぱいあるとおもいますが、ありがとうございました！
===================================================================
Sub main()
Dim rng As Range

　　msg = InputBox("処理内容を選択してね！最大値のみ:0/最小値のみ:1/最大値･最小値:2/条件削除:3")
　　Select Case msg
　　Case 0
　　　　colormax = InputBox("最大値の色を番号で指定してね！")
　　Case 1
　　　　colormin = InputBox("最小値の色を番号で指定してね！")
　　Case 2
　　　　colormax = InputBox("最大値の色を番号で指定してね！")
　　　　colormin = InputBox("最小値の色を番号で指定してね！")
　　End Select
　　
　　Cells.FormatConditions.Delete
　　If msg = 3 Then
　　　　Set rng = Application.InputBox("条件を削除するセル範囲を指定してチョ", , Selection.Address, , , , , Type:=8)
　　
　　Else
　　　　Set rng = Application.InputBox("最大値・最小値の検査対象セル範囲を指定してチョ", , Selection.Address, , , , , Type:=8)
　　End If
　　If Err.Number = 0 Then
　　 Select Case msg
　　　Case 0
　　　　　Call 最大値に色(rng, Array(colormax), 0)
　　　Case 1
　　　　　Call 最小値に色(rng, Array(colormax, colormin), 1)
　　　Case 2
　　　　　Call set_condition(rng, Array(8, 6), 2)
　　　Case 3
　　　　　Call 条件削除
　　　End Select
　　　
　　End If
　　On Error GoTo 0
End Sub
Sub 条件削除()
　　
　　Selection.FormatConditions.Delete
End Sub
Sub 最小値に色(rng As Range, clidx, Optional c_type As Long = 0)
　　
　　Dim obj_idx As Long
　　obj_idx = 1
　　With rng
　　　.FormatConditions.Delete
　　　If c_type = 1 Or c_type = 2 Then
　　　　 .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
　　　　　 Formula1:="=min(" & .Address & ")"
　　　　 .FormatConditions(obj_idx).Interior.ColorIndex = clidx(UBound(clidx))
　　　　 obj_idx = obj_idx + 1
　　　End If
　　End With
End Sub

Sub 最大値に色(rng As Range, clidx, Optional c_type As Long = 0)

　 Dim obj_idx As Long
　　obj_idx = 1
　　With rng
　　　.FormatConditions.Delete
　　　If c_type = 0 Or c_type = 2 Then
　　　　.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
　　　　　Formula1:="=MAX(" & .Address & ")"
　　　　.FormatConditions(obj_idx).Interior.ColorIndex = clidx(LBound(clidx))
　　　　obj_idx = obj_idx + 1
　　　End If
　　End With
　　End Sub

'======================================================================
Sub set_condition(rng As Range, clidx, Optional c_type As Long = 0)
' 機能　　　:　指定されたセル範囲で最大値、最小値のセルに指定された色を設定する
' ＩＮＰＵＴ：　rng　-　設定するセル範囲
'　　　　　　　 clidx-　カラーインデックス　配列形式で指定する
'　　　　　　　　　　　最大値　1　最小値　5　のとき　array(1,5)
'　　　　　　　　　　　ひとつのｶﾗｰｲﾝﾃﾞｯｸｽのみの指定の場合も配列にする事(array(5)のように)
'　　　　　　　c_type　設定のタイプ　0-最大値のみ(規定値)
'　　　　　　　　　　　　　　　　　 1-最小値のみ
'　　　　　　　　　　　　　　　　　 2-最大値・最小値の両方
'　　　　　　　　　　　　　　　　　　そのた-設定削除（偶然)
　
　　Dim obj_idx As Long
　　obj_idx = 1
　　With rng
　　　.FormatConditions.Delete
　　　If c_type = 0 Or c_type = 2 Then
　　　　.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
　　　　　Formula1:="=MAX(" & .Address & ")"
　　　　.FormatConditions(obj_idx).Interior.ColorIndex = clidx(LBound(clidx))
　　　　obj_idx = obj_idx + 1
　　　End If
　　　If c_type = 1 Or c_type = 2 Then
　　　　 .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
　　　　　 Formula1:="=min(" & .Address & ")"
　　　　 .FormatConditions(obj_idx).Interior.ColorIndex = clidx(UBound(clidx))
　　　　 obj_idx = obj_idx + 1
　　　End If
　　End With
End Sub

4 hits

▼

【5870】特定の列の最大値Cellに色を塗りたい takumama 03/6/4(水) 23:00