エクセルマクロで特定の文字を探して隣のセルの色を変える

エクセルに入力されている特定の文字を探し出して隣のセルに色をつけたいと考えています。

検索の対象となるセルは全てのシートのB列です。
検索する文字は色々な英数字の組み合わせの中に含まれています。

　　A 　B
1　 10 ABC000012
2　 20 AAC000013
3　 30 ACC000014

上記のような値が入力されている状態で、B列の"ABC"か"AAC"の何れかが入力されているセルの隣のA列のセルの色を変えたいです。
この場合はA1とA2のセルの色が変わるというイメージです。

VBAを使って処理したいのですが、どなたかご教授頂けないでしょうか。宜しくお願いいたします。

No.3 ベストアンサー 回答者： merlionXX 回答日時： 2009/04/14 13:13

VBAとのご所望なので一例です。

Sub test01()
Dim myRng As Range, c As Range, fAd As String, i As Long
Dim myStr
Set myRng = Range("B1", Cells(Rows.Count, "B").End(xlUp)) 'B列の検索範囲設定
For Each myStr In Array("ABC", "AAC") '指定の各検索文字につき
Set c = myRng.Find(What:=myStr, LookAt:=xlPart, After:=myRng.Cells(myRng.Count)) '部分一致検索
If Not c Is Nothing Then 'あったたら
fAd = c.Address '開始セルを記録
Do '繰り返す
i = i + 1 'カウント
c.Offset(0, -1).Interior.ColorIndex = 8 'セル着色
Set c = myRng.FindNext(c) '連続検索
Loop Until c.Address = fAd '一巡するまで'繰り返し
End If
Next myStr '次の検索文字に
If i = 0 Then 'なかったら
MsgBox "ありません", vbCritical, "？　(￣～￣;)う～ん　　"
Else
MsgBox i & "件を発見しました。", vbInformation, " （￣ー￣）v"
End If
Set myRng = Nothing
Set c = Nothing
End Sub

この回答へのお礼

ご回答頂き有難う御座いました。
思い通りの結果が出ました。
大変感謝しております。

お礼日時：2009/04/15 12:51

No.5 回答者： MKT_ 回答日時： 2009/04/15 01:10

理解しやすさ重視で、超シンプルにいくと、

Sub 特定セル色付け()

　行 = 1 　　'何行目から処理するか指定。今回は「１」行目から
　　　Do While Cells(行, 2) <> "" 　　'B列の値が無くなる行まで、DoWhileとLoopの中を繰り返す
　　　　　文字列 = Cells(行, 2)
　　　　　If InStr(文字列, "ABC") >= 1 Or _
　　　　　　InStr(文字列, "AAC") >= 1 Then 　　'文字列を含むかどうかの判定
　　　　　　　　　Cells(行, 1).Interior.ColorIndex = 3 　　'変更後の色を指定 赤の場合「３」
　　　　　End If
　　　　　行 = 行 + 1
　　　Loop
End Sub





でしょうか。
もし分かりにくい点があるとすれば
　　Do While 「条件式」
　　　　～
　　Loop
の部分かもしれませんが、これは「条件式を満たしている間（満たさなくなるまで）、Do WhileとLoopの中を繰り返せ」という意味です。
　上の例だと、条件式が「　Cells(行, 2) <> ""　」の部分で、「セルが空白（""）じゃない間（空白になるまで）、Do WhileとLoopの中を繰り返せ」つまり「セルが空白になったら終～了～～」という命令になります。
　それまでの間、文字列を含むかどうかの判定と、色付けと、行を１つずつ増やす作業とを繰り返すことによって、作業が１行目からどんどん下に降りていくわけです。


　ちなみに色番号表は参考リンクにきれいにまとめてくださってます。
　
　はやく中級者以上になって、みんなにアドバイスできるような立場になってください。応援してます。

参考URL：http://www.ne.jp/asahi/mabu-messages/greetings-2 …

この回答へのお礼

ご回答有難う御座います。
初心者にとってはとてもシンプルで分かりやすかったです。
皆様のご意見とミックスさせて頂き、とても良いものが完成しました。

また、温かいお言葉をかけて頂き大変感謝しております。
重ねて御礼申し上げます。

お礼日時：2009/04/15 13:03

No.4 回答者： imogasi 回答日時： 2009/04/14 21:25

現状の能力以上の課題を丸投げした感じ。

何から手をつけてよいのか判らないのかな。
まず文章でＶＢＡ向けのすべきことの書上げが出来るようになることが肝心。
>全てのシートのB列です
これは、標準モジュールに置いて
Sub test02()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Name
Next
End Sub
をテスト実行して、全シートがＳｈで捉えられることを実感すること。
ーー
＞B列の"ABC"か"AAC"の何れかが入力されている。
各シートの全データ行を１行ずつ判別することになるから
最終行を捉える必要が有る。
Sub test03()
Dim sh As Worksheet
For Each sh In Worksheets
MsgBox sh.Range("B65536").End(xlUp).Row
Next
End Sub
で、策シートのＢ列の最下行（数）を捉えることを実感すること。
ーー
第１（正確にはデータ最初）行から最下行までのＢ列セルの値（文字列）をを注目し
For i=1 to d
p=Instr(Cells(i,"B"),"ABC")
If p<>0 Then
Cells(i,"A").Interior.ColorIndex=6 'この場合黄色
End If
重ねてすぐ下のコード行に
p=instr(cells(i,"B"),"AAC")
If p<>0 then
Cells(i,"A").Interior.ColorIndex=6
End If
Ｉｎｓｔｒ関数で"ABC"か"AAC"を含むかどうか判別するわけ。
ーー
結局、必要な要素技術（お決まりの少数行のコード）が何か、切り分ける力が十分無いのであろう。それはまづ文章で認識されてもよいものだ。
例　全てのシートをもれなく対象にするには
ーー
ただ処理方法（処理ロジック）は色々かんがえられて、それによって、必要な要素技術は別のものとなる場合が多い。
その良否は、処理ロジックが簡単なもの・コード数が少ないもの・誤りが起こりにくい簡単なもの・自分の使い慣れたものなどが望ましいだろう。
それは経験を積むしかない。
ーー
文字列がＡＢＣ、ＡＡＣだけでなく多数（十以上か目安か）あるときはＩＦブロックを重ねるのでなく、私なら他の方法でやる。
そういうのも、日ごろからポケット（やり方のヴァリエーション）をこつこつ増やしておかないとプログラムを組めない。

この回答へのお礼

ご回答有難う御座います。
ご指摘の通りどのように手をつけていくのかが分からなかったのが実情でした。
大変丁寧な説明で段階的に処理を実感する事が出来、大変勉強になりました。

お礼日時：2009/04/15 12:57

No.2 回答者： M-SOFT#2 回答日時： 2009/04/14 12:07

こんにちは。

No.1さんと同じ意見ですが、検索対象の文字が文字列のどの位置にあっても対応可能にする場合です。条件付き書式の数式を次のようにします。

=OR(ISERROR(FIND("ABC",B2,1))=FALSE,ISERROR(FIND("AAC",B2,1))=FALSE)

No.1 回答者： nattocurry 回答日時： 2009/04/14 11:46

VBAを使って処理したいとのことですが、なぜVBAを使いたいのでしょうか？

VBAを使わなくてもできますが、そのことを知っている上で、VBAを使いたいのでしょうか？

質問者様が、VBAをどれくらい知っているのかが書かれていませんが、どれくらい知っているのでしょうか？
Findメソッドで、部分一致で検索し、OffsetプロパティやInteriorプロパティなどを使えば良いのですが、解りますか？

参考までに、VBAを使わずに、条件付書式で処理する方法を書いておきます。

A1の条件付書式で
数式を
=OR(LEFT(B1,3)="ABC",LEFT(B1,3)="AAC")
として、
A1をコピーし、A2以下に、「形式を選択して貼り付け」で書式だけを貼り付ければ良いです。