[[20080717210904]]　『条件で複数のセルの色を変える方法』（みや）　ページの最後に飛ぶ

『条件で複数のセルの色を変える方法』（みや）

 検索をかけたのですが、当てはまるものが無かったので質問させていただきます。

 条件付き書式を4つ以上付ける方法というのはいくつもあったのですが、条件で複数のセルの色を一度に変える方法というのが探しきれませんでした。
 実際どういうものが作りたいかというと、A列の5より下(A5～A5000ぐらい)のセルに0～12(もう少し増えるかも)の数字が入ります。

 A列の数値　→　カラーコード　
 0　→　38　,
 1　→　40　,
 2　→　36 ,
 3　→　35　,
 4　→　34　,
 5　→　37　,
 6　→　39　,
 7　→　7　,
 8　→　44　,
 9　→　6　,
 10　→　4　,
 11　→　54　,
 12　→　33

 そしてその数字に応じてセルの色を変えたいのですが、A列だけではなくA列～O列のセルの色を変えたいのです。

 例えば
 A5に1と入れると、A5～O5の背景色がピンクに
 A10に2といれると、A10～O10の背景色が黄色に
 といった様に、一つのセルの値で複数のセルの色を変えたいのです。

 値を入力したセル自身・もしくはそれと隣のセルまで、というのは見たことがあるのですが、複数セルの色を変えるものを見つけられませんでした。
 普通に条件付き書式だったらA列の値だけを見るようにすれば複数セルの色が変えられますが、
 その条件を増やしたいのです。
 説明がわかりにくかったらすいません。よろしくお願いします。

 [エクセルのバージョン]　Excel2000
 [OSのバージョン]　Windows2000

 ＞値を入力したセル自身・もしくはそれと隣のセルまで、というのは見たことがあるのですが、
 ＞複数セルの色を変えるものを見つけられませんでした。

 見つけられた解決策が「VBA」だったとしたら、原理としては、同じことだと思います。

 「セル自身から１つ右隣りまで」→「セル自身から１４右隣りまで」に変更するだけだと思います。

 （半平太）

 衝突し、内容もほぼ同じですが・・・

 >値を入力したセル自身・もしくはそれと隣のセルまで、というのは見たことがあるのですが
 これを応用して、色を変える範囲をResizeで広くしてやれば、よいです。
 Resizeプロパティをお調べください。
　　　（SHIOJII）

 回答ありがとうございます。
 当方VBはまったくの初心者で、探したコードを貼り合わせてなんとかしようと思ったのです が、動作がおかしくてどうすればわからない状態です。
 現在使用中のコードを載せますので、よろしければ「ココを変えればいい」というヒントを教えていただけないでしょうか。よろしくお願いします。

 Private Sub Worksheet_Change(ByVal Target As Range)
 Dim c As Variant
 If Target.Column <> 1 Then Exit Sub  'A列以外は処理中止
 If Target.Row < 5 Then Exit Sub      '5行目より上は処理中止
 If Target.Row > 10000 Then Exit Sub    '10000行目より下は処理中止
 If Target.Count = 1 Then
    Select Case Target.Value
        Case ""
            Target.Interior.ColorIndex = xlNone
        Case "0"
            Target.Interior.ColorIndex = 38
        Case "1"
            Target.Interior.ColorIndex = 40
        Case "2"
            Target.Interior.ColorIndex = 36
        Case "3"
            Target.Interior.ColorIndex = 35
        Case "4"
            Target.Interior.ColorIndex = 34
        Case "5"
            Target.Interior.ColorIndex = 37
        Case "6"
            Target.Interior.ColorIndex = 39
        Case "7"
            Target.Interior.ColorIndex = 7
        Case "8"
            Target.Interior.ColorIndex = 44
        Case "9"
            Target.Interior.ColorIndex = 6
        Case "10"
            Target.Interior.ColorIndex = 4
        Case "11"
            Target.Interior.ColorIndex = 54
        Case "12"
            Target.Interior.ColorIndex = 33

    End Select
 Else
    For Each c In Selection
        Select Case c.Value
            Case ""
                c.Interior.ColorIndex = xlNone
            Case "0"
                c.Interior.ColorIndex = 38
            Case "1"
                c.Interior.ColorIndex = 40
            Case "2"
                c.Interior.ColorIndex = 36
            Case "3"
                c.Interior.ColorIndex = 35
            Case "4"
                c.Interior.ColorIndex = 34
            Case "5"
                c.Interior.ColorIndex = 37
            Case "6"
                c.Interior.ColorIndex = 39
            Case "7"
                c.Interior.ColorIndex = 7
            Case "8"
                c.Interior.ColorIndex = 44
            Case "9"
                c.Interior.ColorIndex = 6
            Case "10"
                c.Interior.ColorIndex = 4
            Case "11"
                c.Interior.ColorIndex = 54
            Case "12"
                c.Interior.ColorIndex = 33

        End Select
    Next c
 End If
    Range("A5:A10000").Select
    Selection.Copy
    Range("B5:O10000").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Application.CutCopyMode = False
 End Sub

 これだとA列に文字が入るタイミングでA列の書式をO列までコピーするという感じなのですが、書式をコピーするという方法ではなく、回答してくださったような感じの「色を変える対象をA～Oにする」というにしたいです。
 どうぞよろしくお願いします。（みや）

 こんな感じになると思います。(ROUGE)
'----
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range, clr As Integer
If Intersect(Target, Range("A5:A10000")) Is Nothing Then Exit Sub
For Each c In Intersect(Target, Range("A5:A10000"))
    Select Case c.Value
        Case "": clr = xlNone
        Case 0: clr = 38
        Case 1: clr = 40
        Case 2: clr = 36
        Case 3: clr = 35
        Case 4: clr = 34
        Case 5: clr = 37
        Case 6: clr = 39
        Case 7: clr = 7
        Case 8: clr = 44
        Case 9: clr = 6
        Case 10: clr = 4
        Case 11: clr = 54
        Case 12: clr = 33
        Case Else: clr = xlNone
    End Select
    c.Resize(, 15).Interior.ColorIndex = clr
Next
End Sub

 ROUGE様
 回答ありがとうございます。
 まさに求めていたとおりのものです！本当に助かりました。
 とてもシンプルになって…こんなに短くかけるものなのですね、スゴイです。
 早速使わせていただきます。ありがとうございました。 (みや)

コメント返信：

[ 一覧(最新更新順) ]

[[20080717210904]] 『条件で複数のセルの色を変える方法』（みや） ページの最後に飛ぶ

[[20080717210904]]　『条件で複数のセルの色を変える方法』（みや）　ページの最後に飛ぶ