| |
こんばんわ。
とりあえず、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
|
|
