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)
' 機能   : 指定されたセル範囲で最大値、最小値のセルに指定された色を設定する
' INPUT: 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 質問
【5871】Re:特定の列の最大値Cellに色を塗りたい ichinose 03/6/5(木) 2:19 回答
【5873】Re:特定の列の最大値Cellに色を塗りたい takumama 03/6/5(木) 10:20 質問
【5884】Re:特定の列の最大値Cellに色を塗りたい ichinose 03/6/6(金) 0:41 回答
【5885】Re:特定の列の最大値Cellに色を塗りたい takumama 03/6/6(金) 10:25 お礼
【5891】Re:特定の列の最大値Cellに色を塗りたい takumama 03/6/6(金) 17:15 質問
【5901】Re:特定の列の最大値Cellに色を塗りたい ichinose 03/6/7(土) 10:51 回答
【5905】Re:特定の列の最大値Cellに色を塗りたい takumama 03/6/7(土) 14:27 お礼
【5913】Re:特定の列の最大値Cellに色を塗りたい takumama 03/6/7(土) 22:41 お礼

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