御願いします

質問

Sheet４にある表から同じ値を検索するマクロです。
同じ値があったセルの背景を黄色に，ただし空白セルは空白の
ままにしたいのですが。
うまく動きません。
初めてマクロを立てました。
どうか解決にお力かして下さい。

*********************************************************
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim RetRange As Range
Dim lngYCnt As Long
Dim intXCnt As Integer

lngYCnt = Worksheets("Sheet4").UsedRange.Rows.Count
intXCnt = Worksheets("Sheet4").UsedRange.Columns.Count

For i = 1 To lngYCnt
For j = 1 To intXCnt

If Cells(i, j).Value = "" Then
Cells(i, j).Interior.ColorIndex = xlNone
Else
Set RetRange = Selection.Find(What:=Cells(i, j).Value, _
after:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
If Not RetRange Is Nothing Then
If RetRange.Address <> Cells(i, j).Address Then
RetRange.Interior.ColorIndex = 36
Cells(i, j).Interior.ColorIndex = 36
End If

Next
Next

End If
ErrorHandler:
End Sub

回答No.6

redfox63

デバッグ後のコードです
Private Sub Worksheet_Change(ByVal Target As Range)
　　' 検索先のセル範囲
　　Dim FindRange As Range
　　Set FindRange = Worksheets("Sheet4").UsedRange
　　' Targetが複数セル場合の対処
　　Dim rr As Range
　　For Each rr In Target
　　　　' 空白セルかチェック
　　　　If rr.Value = "" Then
　　　　　　' セル内容を削除した場合の塗りつぶしのリセット
　　　　　　rr.Interior.ColorIndex = xlNone
　　　　　　FindRange.Interior.ColorIndex = xlNone
　　　　Else
　　　　　　Dim retRng As Range
　　　　　　' データの検索
　　　　　　Set retRng = FindRange.Find(rr.Value, after:=FindRange(1, 1), _
　　　　　　　　LookIn:=xlFormulas, _
　　　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, _
　　　　　　　　SearchDirection:=xlNext)
　　　　　　' 同一箇所が見つかったかどうかのフラグ
　　　　　　dim bChange as boolean
　　　　　　If Not retRng Is Nothing Then
　　　　　　　　' 対象データが見つかった場合
　　　　　　　　Dim ss As String
　　　　　　　　' Doループの脱出条件
　　　　　　　　ss = retRng.Address(0, 0)
　　　　　　　　Do
　　　　　　　　　　'rr.Interior.ColorIndex = 36
　　　　　　　　　　if ss <> retRng.Address(0,0) then
　　　　　　　　　　　　retRng.Interior.ColorIndex = 36
　　　　　　　　　　　　bChange = True
　　　　　　　　　　End if
　　　　　　　　　　' 複数同じ記述があるかをチェック
　　　　　　　　　　Set retRng = FindRange.FindNext(retRng)
　　　　　　　　Loop While Not (retRng Is Nothing) And retRng.Address(0, 0) <> ss
　　　　　　End If
　　　　　　' 変更したセル以外のセルが見つかった場合
　　　　　　if bChange then rr.Interior.ColorIndex = 36
　　　　End If
　　Next
End Sub

NetFindはタイプミスです 正しくは FindNextです
最初に検索する場合の引数 Afterには Sheet4のデータ入力セルに左上を指示しています

お礼

何度もありがとうございました。
数を重ねていくうちに少しずつわかってきました。

また，これからも力を借りることがあるかもしれませんが
宜しくお願いします。

回答No.5

redfox63

単純な変数のタイプミスです
　　　　　　ss = retRng.Address(0,0)
としてください
retRangをretRngに変更です

エラーになったらそのエラーに対するヘルプなどを参照して
ご自身でも解決に向かうように努力しましょう
# 検証せずにコードを投稿した私も悪いのですが m(__)m

お礼

ありがとうございます。
何とかヘルプ,インターネットを利用しながら進めています。

NetFindnの箇所がうまく進まず,NextFindに変更してみたのですが・・・
合っているでしょうか？
またセルを変更した後,同じ文字が存在していなくても
背景色が変更してしまします。
私自身でも解決できるよう進めます。
解決方法があれば教えてください！

回答No.4

redfox63

Setが抜けたようです

Set retRng = FindRange.Find( rr.value, after:=ActiveCell,

お礼

早急な回答本当にありがとうございます。
' Doループの脱出条件
　　　　　　ss = retRang.Address(0,0)
でオブジェクトが必要です。
という
エラーが出てしまいました。
解決方法を御願いします。

今日までに仕上げないといけず混乱していたのですが。
救われました。
ありがとうございます。

回答No.3

imogasi

初心者であれば質問のようなコードも、止むをえ無いともいえるが、
逆に初心者なら、条件付き書式の操作をして、マクロの記録を採れば、泥臭くなく、エクセルVBAらしいスマートなコードがわかる。
質問のような繰り返しロジックを使う前に、使わないで済む方法はないのか（結構このケースはある）、立ち止まって勉強することが、進歩につながると思う。
また条件付書式と使い方のエクセル固有の勉強も先立って必要であるが。他プログラム言語経験者などは、エクセルの機能の勉強より、コードの作成が優先しがちとおもうが。
同時に勉強してみては。
Sub Macro1()
Range("A1:C20").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=COUNTIF($A$1:$C$20,A1)>1"
Selection.FormatConditions(1).Interior.ColorIndex = 8
End Sub
A1:C29の可変化・変動化が課題としてあるが。

回答No.2

redfox63

ごめんなさい
for rr in Target
は
for each rr in Target
でした …

お礼

ありがとうございます！
さっそく修正入れました。
' データの検索
　　　　retRng = FindRange.Find( rr.value, after:=ActiveCell,
　　　　　　LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, _
　　　　　　SearchDirection:=xlNext)
部分でもエラーが出てしまったのですが。
お知恵を拝借したいです。
宜しくお願いします。

回答No.1

redfox63

ん?

シート4以外のシートでセルの内容が変更された場合
シート4の中に同一の記述があった場合
シート4と現在のシートのセルを黄色にしたい
といったことでしょうか？

この場合シート4の複数のセルに同じ記述があるのでしょうか？

' 検索先のセル範囲
dim FindRange as Range
Set FindRange = WorkSheets("Sheet4").UsedRange
' Targetが複数セル場合の対処
dim rr as range
for rr in Target
　　' 空白セルかチェック
　　if rr.value ="" then
　　　　rr.interior.colorIndex = xlNone
　　else
　　　　dim retRng as range
　　　　' データの検索
　　　　retRng = FindRange.Find( rr.value, after:=ActiveCell,
　　　　　　LookIn:=xlFormulas, _
　　　　　　LookAt:=xlPart, SearchOrder:=xlByRows, _
　　　　　　SearchDirection:=xlNext)
　　　　if not retRng is nothing then
　　　　　　' 対象データが見つかった場合
　　　　　　dim ss as String
　　　　　　' Doループの脱出条件
　　　　　　ss = retRang.Address(0,0)
　　　　　　do
　　　　　　　　rr.interior.ColorIndex = 36
　　　　　　　　retRng.Interior.ColorIndex = 36
　　　　　　　　' 複数同じ記述があるかをチェック
　　　　　　　　set retRng = findRange.NetFind( rr )
　　　　　　Loop while not( retRng is nothing) and retRng.Address(0,0) <> ss
　　　　end if
　　end if
next
といった具合でしょう …

お礼

さっそくありがとうございます。
とっても心強い解答です。

＞シート4の中に同一の記述があった場合
＞シート4と現在のシートのセルを黄色にしたい
＞といったことでしょうか？
＞この場合シート4の複数のセルに同じ記述があるのでしょうか？

表があるシートがシート４です。
シート４のセルに変更があり，同じ値が存在しているセルの背景を
黄色にしたいのです。

A3に”木村”B６に”木村”D4に”田中”F5に”田中”とあった場合，
木村，田中のセルを黄色に。その他背景はなしです。
さっそく試したとこと
＞for rr in Target
でエラーが出てしまいました。
助言宜しくお願いします。