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

Question

omoro

196

194もっと見る

70pt

コンピュータ

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

セルRに「あ」～「お」の５つの文字を入力する条件付き書式で、セル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

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.2

きゃづみぃ1353911982009/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列の行までというように変えればいいのです。

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

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

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

2009/03/10 23:20:03

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

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

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

リクエスト送信済

回答リクエストを送信したユーザーはいません

Mook · Accepted Answer · 2009-03-10T22:52:24+09:00

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

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

Mook · Accepted Answer · 2009-03-10T22:52:24+09:00

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

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

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

ベストアンサー

Mook13143932009/03/10 22:52:24

その他の回答（1件）

Mook13143932009/03/10 22:52:24ここでベストアンサー

きゃづみぃ1353911982009/03/10 23:03:03

コメント（0件)

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