エクセルVBAで該当するセルに色をつけたい

ご覧いただき、ありがとうございます。
当方、VBA初心者です。

エクセルVBAで、「対象の社名」に該当するセルに色をつけたいと思っています。
それぞれ別シートになります。

たとえば、abc(株)が対象なら、

1.(株)は(株)や株式会社など表記がバラバラなので取る⇒abcの文字列が検索対象
2.「検索シート」にあるabcを検索
3.対象のセルに色をつける
4.文字列がある限り（この場合は○がついている部分はずっと）検索続ける
※○の数式はつけた方が探しやすいと思って作ったので、なくても構いません

わかりづらい文章ですみません。
ぜひお知恵を貸してください＞＜

No.6 ベストアンサー 回答者： kmetu 回答日時： 2013/09/29 22:58

また追加です　追加ばかりで申し訳ありません

検索範囲がB2から始まってるとしたらこちらも変更してください。

MyBottom = Worksheets("検索シート").Range("A" & Rows.Count).End(xlUp).Row
↓
MyBottom = Worksheets("検索シート").Range("B" & Rows.Count).End(xlUp).Row

No.5 回答者： kmetu 回答日時： 2013/09/29 22:03

追加その３です

なんかよーく見ると検索範囲がB2から始まってるみたいなので

With Worksheets("検索シート").Range("A1:A" & MyBottom)
↓
With Worksheets("検索シート").Range("B2:B" & MyBottom)

に変更してください。

この回答へのお礼

こちらで作成したわかりづらい図にも関わらず、
細かい回答ありがとうございました！
現在コーディングしてますので、
もしかしたらまた質問させていただくかもしれません。。
取り急ぎ、お礼申し上げます。

お礼日時：2013/09/30 15:41

No.4 回答者： kmetu 回答日時： 2013/09/29 21:50

追加その２です

なんか左側の画像のシートが社名一覧みたいになっているみたいですが、もしかしてそれをすべて検索したいというのでしたら

シート名が分からないのでSheet2としました

For i = 2 To Worksheets("Sheet2").Range("B" & Rows.Count).End(xlUp).Row
'Myfindstr = Range("C1").Valueの部分が
'↓
Myfindstr = Worksheets("Sheet2").Range("B" & i).Value

先に示したコード

Next i

としてください。

No.3 回答者： kmetu 回答日時： 2013/09/29 21:29

追加です

検索したい社名がどこかのセルにあるとしたら(たとえばC1とか)

Myfindstr = Range("C1").Value

として

Set c = .Find("*abc*", LookIn:=xlValues)

↓

Set c = .Find("*" & Myfindstr & "*", LookIn:=xlValues)

に変更してください。

No.2 回答者： kmetu 回答日時： 2013/09/29 21:22

画像が見難いのでどこに何があるのか分かりませんが

以下のコードはA列に社名があるとして abc を含む社名のセルを見つけてグレーに塗ります。

Dim MyBottom As Long
Dim c As Range
Dim firstAddress As String

MyBottom = Worksheets("検索シート").Range("A" & Rows.Count).End(xlUp).Row
With Worksheets("検索シート").Range("A1:A" & MyBottom)
Set c = .Find("*abc*", LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
With c.Interior
.ColorIndex = 15
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With


なお　.ColorIndex の色は以下のページを参照にして好きなものを選んでください。

http://www.relief.jp/itnote/archives/000482.php

No.1 回答者： tom04 回答日時： 2013/09/29 21:07

こんばんは！

画像が小さくて詳細が判りません。

質問文だけで判断し、「sbc」が含まれているセルを「黄色」に塗りつぶすようにしてみました。

↓のコードを標準モジュールにコピー＆ペーストしてマクロを実行してみてください。

Sub Sample1()
Dim c As Range
For Each c In ActiveSheet.UsedRange
If InStr(c, "abc") > 0 Then
c.Interior.ColorIndex = 6
End If
Next c
End Sub

※　画像ではA列に会社名？があるように見えるのですが、
すべてのセルを対象にしています。m(_ _)m

この回答へのお礼

回答ありがとうございます！！
画像が小さくてすみませんでした…

お礼日時：2013/09/30 11:06