記入した数値によってセルの色分けをしたい

質問

エクセル2000で、セルにある値を入力したらセルの色が自動で変わるようにしたいです。

入力する数値は、-100から+100の範囲、それとブランク(入力なし)です。
表示するセルの色は、１０色以上欲しいです。
セルの数は３６５＊２０位です。

いまは、条件付書式で４色まで、表示できています。
よろしくお願いします。

回答No.4

kazuhiko5681 · ベストアンサー

こんばんは。回答が遅れまして申し訳ございません。早速サンプルマクロを組んでみました。次のように操作してみて下さい。シート１にデータが入力されているということを前提にします。もし違っているのであれば、Sheet1と書いてある部分を例えばシート２に入力されているのであればSheet2と読みかえて下さい。

１.データの入っているブックを開く。
２.Sheet1にコマンドボタンを２個配置する。
　・ファイルメニューにマウスポインターをあわせて右クリックし、出てき　　たプルダウンメニューのVisual Basicをクリックする。
　・出てきたツールバーの右から３番目(コントロールツールボックス)をク　　リックし、コントロールツールボックスの一番右側の上から２番のコマ　　ンドボタンをクリックし、シートの適当な位置でクリックする。(２回繰　　り返す。)
　・ツールバーの２番目(デザインモード)のボタンが押された状態になって　　いたらそのボタンをクリックしてＯＦＦの状態にする。
３.ＡＬＴ＋Ｆ１１を押してＶＢＥ画面を立ち上げ、VBAProjectと書いてある下のSheet1の部分にマウスポインターをあわせてダブルクリックし、右側の白い部分に下記のコードをコピー・ペーストする。
４.ＡＬＴ＋Ｆ１１を押してシート１の画面に戻り、データを入力後コマンドボタンを押す。

あなた様のおやりになりたいことが実現しているはずです。

なお、色につきましては、手操作でセルに色をつける作業をマクロ記録でとると、色のインデックス番号を取得することができます。

もし、不都合なこと・お解りにならないことがありましたらご遠慮なくお知らせ下さい。あなた様のおやりになりたいことが実現できるまで私でよろしければ一緒に考えていきたいと思います。

Private Sub CommandButton1_Click()

Dim myCmd As Integer
Dim myRange As Range
Dim myCell As String

myCmd = 1
If CommandButton1.Caption <> "個別選択" Then
CommandButton1.Caption = "個別選択"
With CommandButton1.Font
.Size = 14
.Bold = True
End With
End If

For Each myRange In Range("C9:AG30")
myCell = myRange.Address
Call Sheet1.myColor(myCmd, myCell)
Next

For Each myRange In Range("AJ9:BN30")
Call Sheet1.myColor(myCmd, myCell)
Next

Call Sheet1.myColor(myCmd, myCell)

End Sub

Private Sub CommandButton2_Click()

Dim myCmd As Integer
Dim myCell As String
Dim myRange As Range

myCmd = 2: myCell = ActiveCell.Address
If CommandButton2.Caption <> "全選択" Then
CommandButton2.Caption = "全選択"
With CommandButton2.Font
.Size = 14
.Bold = True
End With
End If

Call Sheet1.myColor(myCmd, myCell)

End Sub

Sub myColor(myCmd As Integer, myCell As String)

If myCmd = 2 Then
myCell = ActiveCell.Address
End If

Select Case Range(myCell).Value

Case -100
Range(myCell).Font.ColorIndex = 11
Case -10
Range(myCell).Font.ColorIndex = 5
Case 0
Range(myCell).Font.ColorIndex = 41
Case 10
Range(myCell).Font.ColorIndex = 10
Case 15
Range(myCell).Font.ColorIndex = 14
Case 20
Range(myCell).Font.ColorIndex = 43
Case 25
Range(myCell).Font.ColorIndex = 6
Case 30
Range(myCell).Font.ColorIndex = 46
Case 35
Range(myCell).Font.ColorIndex = 52
Case 40
Range(myCell).Font.ColorIndex = 13
Case 100
Range(myCell).Font.ColorIndex = 42

End Select

End Sub

お礼

何とか、使えそうなマクロになりましたので問題がないかどうか見てもらえれば嬉しいです。
教えてもらった、マクロがなければ、一ヶ月は有にかかっていたと思います。

Private Sub CommandButton1_Click()

Dim myCmd As Integer
Dim myRange As Range
Dim myCell As String

myCmd = 1
If CommandButton1.Caption <> "個別選択" Then
CommandButton1.Caption = "個別選択"
With CommandButton1.Font
.Size = 14
.Bold = True
End With
End If

Call Macro2

For Each myRange In Range("C9:AG30")
myCell = myRange.Address
Call Sheet1.myColor(myCmd, myCell)
Next

For Each myRange In Range("AJ9:BN30")
myCell = myRange.Address
Call Sheet1.myColor(myCmd, myCell)
Next

Call Sheet1.myColor(myCmd, myCell)

End Sub

Sub myColor(myCmd As Integer, myCell As String)

Select Case Range(myCell).Value
Case Is = ""

Case Is < -20
Range(myCell).Interior.Color = RGB(200, 100, 230)
Case Is < -10
Range(myCell).Interior.Color = RGB(200, 200, 130)
Case Is < 0
Range(myCell).Interior.Color = RGB(200, 200, 230)
Case Is < 10.5
Range(myCell).Interior.Color = RGB(200, 200, 0)
Case Is < 15.5
Range(myCell).Interior.Color = RGB(0, 200, 200)
Case Is < 20
Range(myCell).Interior.ColorIndex = 43
Case Is < 25
Range(myCell).Interior.ColorIndex = 10
Case Is < 30
Range(myCell).Interior.ColorIndex = 5
Case Is < 35
Range(myCell).Interior.ColorIndex = 6
Case Is < 40
Range(myCell).Interior.ColorIndex = 7
Case Is < 100
Range(myCell).Interior.ColorIndex = 42

End Select

End Sub

>数字ではなく、セルの枠そのものの色を変えたいのです
解決しました。

>全選択の選択肢を無くし
削除しましたが、これでよかったでしょうか、余分なところを消していないでしょうか。

>他のマクロからサブとして呼び出して
このマクロから、他のマクロを呼び出して(Call Macro2)に変えました。

非常に、ありがかたったです。
また質問したときは、よろしくお願いします。

補足

私のために、マクロを組んでくださり、ありがとうございます。

質問の仕方が悪かったのですが、数字ではなく、セルの枠そのものの色を変えたいのです。すみません。これ以外は、私が望んでいたものそのものです。

全選択の選択肢を無くし、個別選択の動作のみとし、他のマクロからサブとして呼び出して使用したいのですが できますでしょうか。

ありがとうございます。もう少し教えてください。

回答No.7

kazuhiko5681

おはようございます。あなた様のマクロをチェックしてみました。問題なく動作すると思います。次の３こは削除した方がいいと思います。

　・Dim myCmd as Integer
・My Cmd = 1
　・Sub myColor の()の中のDim myCmd as Integer　

あなた様の書かれたマクロは、どのセルを選択してもコマンドボタンを押すと、Ｃ９～ＡＧ３０・ＡＪ９～ＢＮ３０のすべてのセルに条件に合った時色がつくという動作をします。
もし、あるセルを選択してコマンドボタンを押した時に選択したセルのみに色がつくという動作をさせたいのであれば、下記のように変更する必要があります。

Private Sub CommandButton1_Click()

If CommandButton1.Caption <> "個別選択" Then
CommandButton1.Caption = "個別選択"
With CommandButton1.Font
.Size = 14
.Bold = True
End With
End If

Call Macro2

Select Case ActiveCell.Value

Case Is = ""

Case Is < -20
ActiveCell.Interior.Color = RGB(200, 100, 230)
Case Is < -10
ActiveCell.Interior.Color = RGB(200, 200, 130)
Case Is < 0
ActiveCell.Interior.Color = RGB(200, 200, 230)
Case Is < 10.5
ActiveCell.Interior.Color = RGB(200, 200, 0)
Case Is < 15.5
ActiveCell.Interior.Color = RGB(0, 200, 200)
Case Is < 20
ActiveCell.Interior.ColorIndex = 43
Case Is < 25
ActiveCell.Interior.ColorIndex = 10
Case Is < 30
ActiveCell.Interior.ColorIndex = 5
Case Is < 35
ActiveCell.Interior.ColorIndex = 6
Case Is < 40
ActiveCell.Interior.ColorIndex = 7
Case Is < 100
ActiveCell.Interior.ColorIndex = 42

End Select

End Sub

１日も早くマクロが完成できますことを陰ながら応援しております。

お礼

何度も、詳しい返事ありがとうございます。

自分で、一からマクロを作ろうとするのは初めてでしたが、の難しいものですね。
どんな、コードを使っていいか、皆目見当がつきませんでした。

今回教えてくださった、マクロはいろいろ使えそうですので、大事にとっておきます。

また、違うマクロで聞きたいことがあるのですか、調べて判らなかったら質問を立てますのでよろしくお願いします。

回答No.6

kazuhiko5681

こんばんは。早速あなた様のご質問にお答えしたいと思います。

＞他のマクロからサブとして呼び出して使用したいのですが できますでしょうか。
できます。Call マクロ名というコードを1行加えることによってプロシージャーを呼び出して実行することができます。
前回、Call Sheet1.myColor(myCmd, myCell)というコードを使っていますが、まさにこれがそうです。このコードの意味は、「シート1にあるmyColorというプロシージャーを呼び出して実行せよ。」という意味なのです。
(myCmd, myCell)は、今回は無視して下さい。

＞数字ではなく、セルの枠そのものの色を変えたいのです。
これは簡単に変更することができます。FontをInteriorと変えれば、セル全体に色が塗られます。

もし、サンプルマクロをご希望でしたら、次のことをお知らせ下さい。
　・呼び出し元のマクロでやらせたい内容。
　・呼び出し先のマクロでやらせたい内容。
　・データ入力は、シート１だけでよいのか。それともシート２・シート３・・・と入力することがあるのか。
　・呼び出し元のマクロと呼び出し先のマクロは同一ブック内でよいのか。

よろしくお願いいたします。

回答No.5

imogasi

＃３のものです。捕捉に書かれたことに対して
（１）色が変わるセルの範囲が指定できて・・
これは割合簡単に出来そうです。
プロシージュアの最初に
If Target.Column <> 1 Then
Exit Sub
End If
をいれるとＡ列だけに出来ます。行はTarget.Rowで判断
します。
（２）数式でも、値の入力ができるといいのですが。
Ｂ７に１２、Ｃ７に２５をいれ、Ａ７に＝Ｂ７＋Ｃ７をいれると、ブルーになりましたが。
（３）その他
本件はセルの値が変わるごとに、いわば「動的に」色づけ
していますが、値・式をいれ終わり、計算を終わってからの値で色づけする、いわば「静的な」方法の方が良いかもしれない。
（４）エラーが出る問題
Ｃｈａｎｇｅイベントとからんでいると思うので、ある限定された場合に上手く行かないケースがあり、その手当て
が出来ていないかもしれませんが、取りあえずの提供と言うことでよろしく。

お礼

何度も、教えていただき、ありがとうございます。

>Ｂ７に１２、Ｃ７に２５をいれ、Ａ７に＝Ｂ７＋Ｃ７をいれると、ブルーになりましたが
バージョンの問題でしょうか、できませんでした。

>「静的な」方法
これをkazuhiko5681さんから教えてもらっています。

また質問を見かけたらよろしくお願いします。

回答No.3

imogasi

>この後どうすればいいのかまったくわかりません。
コードが正しく入力されたら、Ｓｈｅｅｔ１に戻って
どのセルでも良いですから１から１００までの数を
入力してＥＮＴＥＲ］キーを押してください。すると
ＣＨＡＮＧＥイベントが自動発生し、本プログラムが走り
ます。するとセル値に応じてセルに色がつきます。
＞「'b行の２行、'cの２行は同一行にしてください。 」の部分が、わかりません。
●ＯＫＷＥＢでは横１行の文字数に制約があり、強制的に改行されてしまいます。（スペース＋ウンダースコアで改行も可能なんですがそのままにしています。）
●条件付書式をマクロの記録を取っていただければ、'aと'bの部分は正しい表記法で出てきます。
●さて直接答えると、'aの２行のうち上の'aの'の前にカーソルを置いて、ＤＥＬキーで削除し、（前部分略）
・・xlBetween,Formula・・・となるようにしてください。
'bの部分は、（全部分略）
・・FormatConditions(1).Interior.ColorIndex = ci
となるようにしてください。

補足

回答ありがとうございます。
うまくいきました。数字を打ち込んで色が出てくるなんて、ちょっと感動ものです。

遅くなりしたが、その訳は、変数の宣言を強制するにチェックが入っていたので、エラーか出たのと、:=xlBetween, _ 'a Formula1を　:=xlBetween, Formula1にするのに、迷っていたからです。

それとたまにエラーが出ます。同じセルに何度も入力すると発生するみたいです。メッセージは以下のとおりです。
実行時エラー　1004
アプリケーション定義またはオブジェクト定義のエラーです。
デバッグを選択すると、次の行が黄色で選択されてます。
Target.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, Formula1:=f, Formula2:=t

あと、色が変わるセルの範囲が指定できて、それに、数式でも、値の入力ができるといいのですが。注文が多くてすいません。

ありがとうございました。

回答No.2

imogasi

操作による書式－条件付き書式では３種しか設定できないようです。プラス標準の白色１種と４種ですね。
それで下記ＶＢＡを作ってみました。セル値により１０種設定しています。
１００まで１０刻みなんですが、Case Is > 100等の100とf = "101": t = "1000": ci = 12の部分を適当な範囲に修正してください。
case文は大きい数から順に、上から設定してください。
色のColorIndex 以外のＲＧＢでの指定方法は、本等を見てください。
Private Sub Worksheet_Change(ByVal Target 'c
As Range) 'c
Select Case Target
Case Is > 100
f = "101": t = "1000": ci = 12
Case Is > 90
f = "91": t = "100": ci = 11
Case Is > 80
f = "81": t = "90": ci = 10
Case Is > 70
f = "71": t = "80": ci = 9
Case Is > 60
f = "61": t = "70": ci = 8
Case Is > 50
f = "51": t = "60": ci = 7
Case Is > 40
f = "41": t = "50": ci = 6
Case Is > 30
f = "31": t = "40": ci = 5
Case Is > 20
f = "21": t = "30": ci = 4
Case Is > 10
f = "11": t = "20": ci = 3
Case Else
f = "1": t = "10": ci = 2
End Select
'---------
Selection.FormatConditions.Delete
Target.FormatConditions.Add 'a
Type:=xlCellValue, Operator:=xlBetween, _ 'a
Formula1:=f, Formula2:=t 'a
Target.FormatConditions 'b(1).Interior.ColorIndex = ci 'b
End Sub
上記'aの３行、'b行の２行、'cの２行は同一行にしてください。
（１）ＡＬＴキーを押しながらＦ１１キー
（２）Ｓｈeｅｔ１のＣｈａｎｇｅイベントプロシジュアとして上記を貼り付ける。

補足

回答　ありがとうございます。

今、エクセルを開いて、ＡＬＴキーを押しながらＦ１１キー を押し、
Sheet1(Sheet1)　 Worksheet Change　　となっています。
ここの
Private Sub Worksheet_Change(ByVal Target As Range)

End Sub　をimogasiさんの物と入れ替えました。
Private Sub Worksheet_Change(ByVal Target As Range) 'c
Select Case Target
・
・
'---------
Selection.FormatConditions.Delete
Target.FormatConditions.Add 'a Type:=xlCellValue, Operator:=xlBetween, _ 'a Formula1:=f, Formula2:=t 'a
Target.FormatConditions 'b(1).Interior.ColorIndex = ci 'b
End Sub

>上記'aの３行、'b行の２行、'cの２行は同一行にしてください。
この説明の「'b行の２行、'cの２行は同一行にしてください。 」の部分が、わかりません。

それと、この後どうすればいいのかまったくわかりません。
すみませんです。よろしかったら、もっと詳しく教えてください。

回答No.1

kazuhiko5681

はじめまして。あなた様のおやりになりたいことは、マクロを組めば簡単に実行できます。もし私でよろしければ、サンプルマクロを作ってみようかと思います。ご希望の節は次のことをお知らせ下さい。

１.色をつけたいセルの位置(例えば、Ａ・Ｃ・Ｅと１行おきにとかＡ・Ｄ・Ｇ列のみとかと書いていただけると助かります。)
２.色の配色方法(例えば-100～-10まで緑・-10～10までは黄色というように書いていただけると助かります。)

お手数をおかけいたします。よろしくお願い申し上げます。

補足

返事、ありがとうございます。

私のマクロの程度は、操作をマクロとして記録して実行か、または記録されたマクロ中のセルのA1をB2に変えるくらいです。

>１.色をつけたいセルの位置
C9~AG30 AJ9~BN30 ・・・・(行　9~30、　列 31列かけ12個、間に二列の空白)

>２.色の配色方法
-100濃い青-10青0薄い青10青緑15緑20黄緑25黄30橙35赤橙40赤100
色は最終決定ではありません、出来上がったものを見て、変えたいと思います。

マクロの実行は１２個個別に実行か、すべて実行か両方あるとあると嬉しいです。

よろしくお願いします。