• ベストアンサー

4つ以上の条件検索 色分け

過去の質問集を見て自分なりにアレンジをしたのですが、なかなか思ったようなものができないのでお尋ねします。 たとえば、下記のように A1~B3に数値のデータが入っています。     A      B 1    0     5 2    6     10 3    11    20 次にD1~F3の中には0~20の数値になるように設定された計算式が入力されています。 (例えば、A5に"10"を入力するとD1~F3に結果が出力されます) マクロを実行すると、D3~F3内のセルの色を4つの条件ごとに変更したいのですが、条件の設定とD3~F3の中のみマクロを有効にするという設定がなかなかうまく出来ません。 (1)A1~B1の間は赤 (2)A2~B2の間は黄 (3)A3~B3の間は青 (4)それ以外は塗りつぶしなし Select~Caseなどいろいろ試したのですが、中途半端な知識しかないので細かい部分での作成ができません。 回答お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • kuma3f
  • ベストアンサー率63% (28/44)
回答No.2

思われていることができているかどうか分かりませんが下記の方法はどうでしょうか。 「ツール」→「オプション」→「編集」で「入力後にセルを移動する」にチェックを入れる 方向は「下」にする 「OK」をクリック (この設定は、セル入力後、セルが下へ移動するようにしています)   ↓ 「ツール」→「マクロ」→「Visual Basic Editor」 「表示」→「コード」   ↓ 下記のコードをコピーして貼り付けてください。 Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) '***** 特定セルを選択するとイベントを実行する ***** Dim たて As Long Dim よこ As Long Dim たてカウント As Long Dim よこカウント As Long Dim 色づけセル値 As Long たて = ActiveCell.Row よこ = ActiveCell.Column If よこ = 1 Then If たて = 6 Then 'A6が選択されたら たてカウント = 1 よこカウント = 4 Do Do Cells(たてカウント, よこカウント).Interior.ColorIndex = xlNone '塗りつぶしなし 色づけセル値 = Cells(たてカウント, よこカウント) If Range("A1").Value <= 色づけセル値 Then If 色づけセル値 <= Range("B1").Value Then Cells(たてカウント, よこカウント).Interior.ColorIndex = 3 '赤色 End If End If If Range("A2").Value <= 色づけセル値 Then If 色づけセル値 <= Range("B2").Value Then Cells(たてカウント, よこカウント).Interior.ColorIndex = 6 '黄色 End If End If If Range("A3").Value <= 色づけセル値 Then If 色づけセル値 <= Range("B3").Value Then Cells(たてカウント, よこカウント).Interior.ColorIndex = 5 '青色 End If End If よこカウント = よこカウント + 1 Loop Until よこカウント > 6 よこカウント = 4 たてカウント = たてカウント + 1 Loop Until たてカウント > 3 End If End If skip01: End Sub A5に数字を入力し、Enterキーを押すとセルが下へ移動するのでA6が選択されたら条件によってセルに色づけがされます。 コードの「たて」「よこ」が選択セルの位置になります。

michel09
質問者

お礼

回答ありがとうございました。 やりたいことの作成ができました。 お礼が遅れ、申し訳ありませんでした。

その他の回答 (1)

  • imogasi
  • ベストアンサー率27% (4737/17069)
回答No.1

>D3~F3の中のみマクロを有効にするという Changeイベントというものを使うことになると思うが、経験はありますか。 また対象セル範囲の限定は Private Sub Worksheet_Change(ByVal Target As Range) Set rng = Range("D3:F3") If Intersect(rng, Target) Is Nothing Then MsgBox ActiveCell.Address(0, 0) & "は範囲外です。" End If End Sub のような高等な?テクニックがいる。 泥臭くIF文を重ねてもできるが。 http://www.geocities.co.jp/SiliconValley-SanJose/9236/subdoc2/0186.htm ーーー >を4つの条件ごとに変更 エクセルの2007以前の入力規則を使わないなら3つと言う制限は 関係ない。 VBAでケース文で4つ以上に分けて、ColorIndex値をそれぞれセットすればしまい。 全般にこの質問をやるレベルに達して無いと思う。 質問もわかりにくい。 余分なことを書いている。 下記の点など。 >過去の質問・・ >0~20の数値になるように設定された計・・ セルの値を問題にするので、関数式で値が出されていようと来歴は関係ない。

michel09
質問者

お礼

回答ありがとうございました。 どうにかやりたいことができました。 本当にありがとうございます。

関連するQ&A