VBAで教えてください。

質問

以前ここで教えていただいたＶＢＡで
http://jisaku.155cm.com/src/1371930716_9b9006528605642980beed48a8998013b0731e4b.jpg
のようにＡ列のテスト４をクリックしたときにＣ列のテスト４が一発で解るようにしたいです。
もちろん、テスト１１をクリックしたときは、テスト４塗りつぶしは解除され、
テスト１１が塗りつぶされるようにしたいです。
写真は塗りつぶししていますが、解るようにしたいだけなので、塗りつぶしにはこだわっていません。
あと、Ｅ、Ｆ、Ｇ列は解りやすく並べているだけで、実際はＡ、Ｂ、Ｃ列だけです。
それと、Ｃ列は関数を使って表示してあります。
という質問で

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から
Dim i As Long
Range("C:C").Interior.ColorIndex = xlNone
If Application.Intersect(Target, Range("A:A")) Is Nothing Or Target.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Cells.interio.ColorIndex = xlNone
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, "C") = Target Then
Cells(i, "C").Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

をシートのコードに張り付ければいいですよ。と教えてくれたものがあるのですが、
Ａ列でクリックした文字をＣ列からすべて見つけて反転してくれないようです。何個か反転してくれない
ものが出てきてしまいました。
Ｃ列が何百行とかなってしまうと、すべての同じ文字を検索してくれないのでしょうか？
ちなみに列がここに掲載しているものと違うので

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'この行から
Dim i As Long
Range("R:R").Interior.ColorIndex = xlNone
If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
ActiveSheet.Cells.interio.ColorIndex = xlNone
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, "R") = Target Then
Cells(i, "R").Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

のＣをＲにＡをＢに変更して使ってます。
これがいけないのかな？
よろしくお願いします。

回答No.3

tom04 · ベストアンサー

No.2です！
たびたびごめんなさい。

前回の投稿は無視してください。全く意味のないコードになっていました。
やりたいコトはB列をクリックしR列に同じデータがあると判るようにしたいというコードだと思いますので、
↓のコードにしてみてください。
No.1さんが回答されていらっしゃるようにR列でループしないといけませんね！

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim i As Long
Range("R:R").Interior.ColorIndex = xlNone
If Application.Intersect(Target, Range("B:B")) Is Nothing Or Target.Count <> 1 Then Exit Sub
On Error Resume Next
Application.ScreenUpdating = False
For i = 1 To Cells(Rows.Count, "R").End(xlUp).Row
If Cells(i, "R") = Target Then
Cells(i, "R").Interior.ColorIndex = 3
End If
Next i
Application.ScreenUpdating = True
End Sub

今度はどうでしょうか？m（_ _）m

お礼

こんにちは～。たびたび申し訳ございません。
今度は無事に動きました。
本当にありがとうございます。＾＾
助かりました。

回答No.4

MarcoRossiItaly

次回から、追加のご質問をされる場合は、前回の質問ページのアドレスを新たな質問文に載せるようにしてください。

恐らくコード中、次の箇所を修正すれば正常に動作しそうです。ケアレスミスでしょうね。

×　Cells(Rows.Count, 1)
↓
○　Cells(Rows.Count, "c")
あるいは
○　Cells(Rows.Count, "r")

このコードは、ある列においてデータが存在する最下行のセルを表しています。現状では、B 列のデータと同じ行数までは、R 列にも色が付いているのではないですか。

回答No.2

tom04

こんにちは！
前回投稿した者です・・・

ごめんなさい、。おそらく単なるタイピングミスだと思います。
＞ActiveSheet.Cells.interio.ColorIndex = xlNone
を
＞ActiveSheet.Cells.Interior.ColorIndex = xlNone
にしてください。

「Interior」が間違っています。ｍ（_ _）ｍ

回答No.1

MSZ006

９行目あたりに

For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row

という行がありますが、これを

For i = 1 To Cells(Rows.Count, 3).End(xlUp).Row

としてみたらどうでしょうか？