エクセルVBAのイベントで色付け

質問

以前条件付書式で対応できない4色以上の問題で質問しましたが、
応用がきかず再度質問に参りました。

データリストの表です。
2行目に見出しがあります。B4:G4とします。
その下(3行目)に日にちを入力するようにしています。3行目から10行目
とします。
つまりB4:G10までが対象になります。
2行目にはそれぞれ違った色を付けています。

この様な場合で、
B4:G10に日にちが入ると、その列にある2行目の見出しの色と同じ
色を付ける、というようにしたいのですが、前回教えていただいた
ものを参考にしてみたのですが、応用ができませんでした・・・
どなたか教えていただけないでしょうか。

回答No.5

merlionXX · ベストアンサー

＃1-4のmerlionXXです。
さきほど回答したダブルクリックの件ですが、＃3でWendy02さんがご回答のように日付か否かの判断をいれてやれば何もダブルクリックを無効にする必要はないですね。修正します。
以下だけで対応可能です。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Intersect(Target, Range("B3:G10")) Is Nothing Then Exit Sub
If Target.Cells.Count > 1 Then
MsgBox "対象セルはひとつにしてね。"
Exit Sub
End If
c = Target.Column
If IsDate(Target.Cells.Text) Then
Target.Interior.ColorIndex = Cells(2, c).Interior.ColorIndex
Else
Target.Interior.ColorIndex = xlNone
End If
End Sub

お礼

ありがとうございました。ばっちりできました。

回答No.6

Wendy02

#3の回答者ですが、

>どういう訳か日付を入れても
>色が変わりませんでした。実際の範囲はF4:AZ503で、

おそらく、見出しの色が間違ってはいないようですから、後は、ここの場所です。

　If IsDate(Target.Cells.Text) Then

ここで判定される、日付とは、日付と判定されるべきものですから、数字でもシリアル値でもありません。あくまでも、書式で日付と判定できるものです。なお、Taget.Cells は、ここでは、Target.Cells(1) と同じ意味です。

お礼

たびたびすみませんでした。日付をユーザー定義で「05/25」のように
しています。2008/5/25のようにも変えたりしたのですが、状況が
変わりまんでした。私の気づいていない部分でミスがあるかもしれ
ませんが・・・。

回答No.4

merlionXX

> 範囲内で、ダブルクリックしても色がつきますが、こういうものでしょうか？

ダブルクリックで色がついたのではなく、ダブルクリック後に確定（Enterキーまたは矢印キー）したからChangeイベントが発生したのです。範囲内でダブルクリックしても無反応になるようにするなら同じシートモジュールに以下を追記してみてください。

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("B3:G10")) Is Nothing Then Exit Sub
Cancel = True
End Sub

回答No.3

Wendy02

こんばんは。

すでに回答は出ていますが、私の考え方を示しておきます。

基点となるセルが決まっている場合には相対位置で言いますが、イベント・ドリブン型は、あくまでも、ユーザー設定が基本ですから、通常は、絶対位置のセルのアドレスを使います。私の経験では、ご質問の相対位置の考え方は、マクロをより複雑化させますので、自分で理解しにくくなります。

なお、セル等の位置情報は、ご自分で直してください。
----------------------------------------------

Private Sub Worksheet_Change(ByVal Target As Range)
'セルを二つ以上選択したりしたら、不可
If Target.Cells.Count > 1 Then Exit Sub
'色を変える範囲
If Not Intersect(Target, Range("G4:G10")) Is Nothing Then Exit Sub
　　'もし、日付なら色を変更する
　　If IsDate(Target.Cells.Text) Then
　　　　Target.Cells.Interior.ColorIndex = _
　　　　Cells(2, Target.Column).Interior.ColorIndex　'元になる行(2)
　　Else
　　　'そうでない場合は書式を含めて元に戻す
　　　 Target.Cells.Interior.ColorIndex = xlNone
　　　 Target.NumberFormat = "General"
　　End If
End Sub

'書式自体も戻さないと、一般の数字が日付に変更されてしまいます。

#以前の質問
http://oshiete1.goo.ne.jp/qa3994153.html

一応、確認はしました。

お礼

ご回答ありがとうございました。
ためさせていただいたのですが、どういう訳か日付を入れても
色が変わりませんでした。実際の範囲はF4:AZ503で、
見出しの行が3行目で、
If Not Intersect(Target, Range("F4:AZ503")) Is Nothing Then Exit Sub

Cells(3, Target.Column).Interior.ColorIndex　

としています。

回答No.2

imogasi

もう回答は出ていますが
日付を入れたセルについて
　　セルの値　Target.Vakue
　　列 Target.Column
　　行 Target.Row
で捉えられることは、前の質問回答でも出てたでしょう。
同列の第２行は
　　　Cells(2,Target.Column)
であることが思いつかないですか。
このセルの色は　Cells(2,Target.column).Interior.ColorIndexで捉えられるので、Teget.Interior.Colorindex　の値に
をCells(2,Target.column).Interior.ColorIndex　の値を代入すればよい。
新しい知見は何も必要ないと思うが。
ーー
あと、条件が整えば色をつける範囲B4:G10のチェックですが、Interceptが定石ですが
（下記は範囲内外検出テスト用）
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 3 And Target.Row < 11 And Target.Column > 1 And Target.Column < 8 Then
MsgBox "範囲内"
Else
MsgBox "範囲外"
End If
End Sub
というようなものでも良いではないですか。

お礼

前回はありがとうございました。
今回もご回答ありがとうございました。

回答No.1

merlionXX

以前した質問の関連質問なら以前の質問へのリンクくらい張りましょうよ。

> 2行目に見出しがあります。B4:G4とします。

2行目ならB2:G2なのでは？

> その下(3行目)に日にちを入力するようにしています。3行目から10行
とします。
> つまりB4:G10までが対象になります。

3行目から10行目ならG3:G10でしょう？

上記だとして、

Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Integer
If Intersect(Target, Range("B3:G10")) Is Nothing Then Exit Sub
c = Target.Column
Target.Interior.ColorIndex = Cells(2, c).Interior.ColorIndex
End Sub

もし見出しがB2:G2ではないのなら違ってきますが・・・。

お礼

こんばんは。リンクのことから、説明の間違い・・・すべて仰るとおりでした。スミマセン。
ためさせていただき、見事にできました。ただ、こういうものなのかわかりませんが、ひとつ疑問に思うことがあります。
範囲内で、ダブルクリックしても色がつきますが、こういうものでしょうか？