EXCLEのマクロについて質問です。

セルRに「あ」~「お」の5つの文字を入力する条件付き書式で、セルRに文字が入力されると対応する条件でRセルの文字色、セル色を塗り分け、かつ「お」の場合はC~Oのセルに色を塗りたいんです。
そこで下記のマクロを作ったんですが、C~O全ての列に色がついてしまいました。入力した行だけ色を塗りたいんですが、どうしたらいいのでしょうか。
素人なので、コードにコメントがあると有難いです。

----------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim intColor As Integer
Dim celcolor As Integer


If Target.Count > 1 Then Exit Sub
If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub

Select Case Target.Value

Case Is = "あ"
intColor = 1
celcolor = 2
Case Is = "い"
intColor = 1
celcolor = 2
Case Is = "う"
intColor = 1
celcolor = 3
Case Is = "え"
intColor = 1
celcolor = 4
Case Is = "お"
intColor = 1
celcolor = 5
Range("c:o").Interior.ColorIndex = celcolor
End Select

Target.Font.ColorIndex = intColor
Target.Interior.ColorIndex = celcolor
End Sub

回答の条件
  • 1人2回まで
  • 登録:2009/03/10 22:40:03
  • 終了:2009/03/10 23:20:30

ベストアンサー

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912009/03/10 22:52:24

ポイント35pt

コメントは少ないですが、下記のようでどうでしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intColor As Integer
    Dim celcolor As Integer

'// R 行がなければ終了
    If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
    
    Dim r As Range
    Application.EnableEvents = False

'// 一度に複数行の変更に対応(コピー&貼付け等)
    For Each r In Intersect(Target, Range("R:R"))
        Select Case Target.Value
            Case "あ"
            intColor = 1
            celcolor = 2
            Case "い"
            intColor = 1
            celcolor = 2
            Case "う"
            intColor = 1
            celcolor = 3
            Case "え"
            intColor = 1
            celcolor = 4
            Case "お"
            intColor = 1
            celcolor = 5
'// 行の指定を追加
            Range("C" & r.Row & ":O" & r.Row).Interior.ColorIndex = celcolor
        End Select

        Target.Font.ColorIndex = intColor
        Target.Interior.ColorIndex = celcolor
    Next
    Application.EnableEvents = True
End Sub
id:omoro

ありがとうございます!

先ほど、動作確認したら意図した動作となっておりました。

ちょっとした事で結果が変わるので難しいですね。マクロって。

2009/03/10 23:12:19

その他の回答(1件)

id:Mook No.1

Mook回答回数1312ベストアンサー獲得回数3912009/03/10 22:52:24ここでベストアンサー

ポイント35pt

コメントは少ないですが、下記のようでどうでしょうか。

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim intColor As Integer
    Dim celcolor As Integer

'// R 行がなければ終了
    If Intersect(Target, Range("R:R")) Is Nothing Then Exit Sub
    
    Dim r As Range
    Application.EnableEvents = False

'// 一度に複数行の変更に対応(コピー&貼付け等)
    For Each r In Intersect(Target, Range("R:R"))
        Select Case Target.Value
            Case "あ"
            intColor = 1
            celcolor = 2
            Case "い"
            intColor = 1
            celcolor = 2
            Case "う"
            intColor = 1
            celcolor = 3
            Case "え"
            intColor = 1
            celcolor = 4
            Case "お"
            intColor = 1
            celcolor = 5
'// 行の指定を追加
            Range("C" & r.Row & ":O" & r.Row).Interior.ColorIndex = celcolor
        End Select

        Target.Font.ColorIndex = intColor
        Target.Interior.ColorIndex = celcolor
    Next
    Application.EnableEvents = True
End Sub
id:omoro

ありがとうございます!

先ほど、動作確認したら意図した動作となっておりました。

ちょっとした事で結果が変わるので難しいですね。マクロって。

2009/03/10 23:12:19
id:taknt No.2

きゃづみぃ回答回数13481ベストアンサー獲得回数11982009/03/10 23:03:03

ポイント35pt

Range("c:o").Interior.ColorIndex = celcolor

の行を

Range(Cells(Target.Row, "c"), Cells(Target.Row, "o")).Interior.ColorIndex = celcolor

に変えれば 入力した行だけ色が 変わります。

"c:o"

この指定だと C列からO列すべてと なります。

入力した行は Target.Rowになりますので、

このC列の行からO列の行まで というように変えればいいのです。

id:omoro

添削ありがとうございます!

期待した動作となりました!!

お二人にイルカ賞をあげたいですが、今回は先着順とさせて頂きますね。

2009/03/10 23:20:03

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません