エクセルのVBAについて質問です。

質問

エクセル２００３のVBAについて質問です。
複数の検索したい文字列があり、複数の検索対象セルがあります。
セルの文字列が検索文字列のいずれかと一致したセルの背景の色を変えたいです。
よろしくおねがいします。

仕事でマクロを組まなけばならなくなってしまったのですが、
初心者のため検索してみたり調べてみたり、参考にして作ってみたのですがうまくいかないばかりかどんどん解らなくなってしまいました。
どうか助けてください。

sheet1のセルが検索対象
（全セル対象でも大丈夫ですが、検索したいセルはB2→J2、B11→J11、B20→J20の範囲です）、
sheet2のA列に検索したい文字列が入力されています。
この検索したい文字列は今後増えていく可能性があるので、増えた場合にも対応できるようにと考えています。

sheet1（検索対象）
あ い う え あ お お

sheet2（検索文字列）
あ
う
お
け
き

↑の様に入力されており、sheet1の「あ」と「う」と「お」のセルの背景を変えたいです。
色を変えたいのはsheet1です。

findメソッドや繰り返し処理などを調べて実践してみたのですが、
いきなりマクロを組めといわれた超初心者には難しく質問しています。
自分でやってみたのですが、
sheet1の最初の「あ」のみが変換され、後に出てくる「あ」が変換されません…
どうしたらいいのか…どうすることも出来ず困っております。
すみませんが、どなたか優しい方助けてください。
よろしくおねがいします＞＜

回答No.3

hallo-2007 · ベストアンサー

一例ですが
＞findメソッドや繰り返し処理などを調べて実践してみたのですが、
なので
Sub ボタン1_Click()
Dim cc As Range
Set cc = Sheets(1).Range("B2:J2,B11:J11,B20:J20")
For Each c In cc
Set s = Sheets(2).Columns("A").Find(c.Value, LookAt:=xlWhole)
If s Is Nothing Then
Else
c.Interior.ColorIndex = 6
End If
Next
End Sub

とか
＞全セル対象でも大丈夫ですが
ならば
Sub ボタン1_Click()
Dim cc As Range
Set cc = Sheets(1).UsedRange
For Each c In cc
If c.Value <> "" Then
Set s = Sheets(2).Columns("A").Find(c.Value, LookAt:=xlWhole)
If s Is Nothing Then
Else
c.Interior.ColorIndex = 6
End If
End If
Next
End Sub

とか云った方法もあります。

回答No.2

tom04

No.1です！
補足の件について・・・
＞2行目のみしか色がつかなかった

すなわち11・20行目には色がつかなかったというコトですね！

前回は2・11・20行だけの選択にしていましたが、
とりあえず2～20行目全セルを対象にしてみてはどうでしょうか？

もう一度コードを載せてみます。

Sub test() 'この行から
Dim i, j As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") '←「Sheet2」の部分は実際のSheet名に！
Application.ScreenUpdating = False
Cells.Interior.ColorIndex = xlNone
For i = 2 To 20
For j = 2 To 10
If WorksheetFunction.CountIf(ws.Columns(1), Cells(i, j)) Then
Cells(i, j).Interior.ColorIndex = 6 '←色は好みで！
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub 'この行まで

こんな感じではどうでしょうか？m(_ _)m

回答No.1

tom04

こんにちは！
一例です。
Sheet2のA列に検索したい文字を入力しておきます。

画面左下のSheet1のSheet見出し上で右クリック　→　コードの表示　→　VBE画面に
↓のコードをコピー＆ペーストしてマクロを実行してみてください。
（Alt+F8キー　→　マクロ　→　マクロ実行です）
※　とりあえずセル色は「黄色」としています。

Sub test() 'この行から
Dim i, j As Long
Dim ws As Worksheet
Set ws = Worksheets("Sheet2") '←「Sheet2」の部分は実際のSheet名に！
Cells.Interior.ColorIndex = xlNone
For i = 2 To 20 Step 9
For j = 2 To 10
If WorksheetFunction.CountIf(ws.Columns(1), Cells(i, j)) Then
Cells(i, j).Interior.ColorIndex = 6 '←色は好みで！
End If
Next j
Next i
End Sub 'この行まで

参考になりますかね？m(_ _)m

補足

ありがとうございます。
さっそく実行してみたのですが、２行目のみしか変換されなかったのですが…
どうしたらいいでしょうか？
改善する技術もなく、頼ってばかりで申し訳ないですが、
アドバイスくださると助かります。