エクセルで複数の文字を検索し、その文字に特定文字を付与する

タイトル通りですが、エクセルで次のマクロが組みたいです。
例）A列にA～Zという文字列がランダムに記載されているとして、
そのうちB、D、Zに●を付与する。
なお、●の付与は一度のみで、再度クリックしても●が付与されない

色々、サイトで検索してみましたが、どうしても出来ませんので、どなたかご存知の方、教えて頂けないでしょうか。
無知ですので、お手数ですが、具体的に教えて頂けると助かります。
どうか宜しくお願い致します。

No.1 回答者： tom04 回答日時： 2015/06/01 20:59

こんばんは！

＞そのうちB、D、Zに●を付与する。
とは別列表示で良いのでしょうか？
とりあえずB列に「●」を表示するようにしてみました。
一例です。

Sub Sample1()
Dim k As Long, c As Range, myAry As Variant
myAry = Array("B", "D", "Z")
Range("B:B").ClearContents
For k = 0 To UBound(myAry)
Set c = Range("A:A").Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then
c.Offset(, 1) = "●"
End If
Next k
End Sub

＞なお、●の付与は一度のみで、再度クリックしても●が付与されない
の意味がよく判らないので
的外れならごめんなさいね。m(_ _)m

この回答へのお礼

回答ありがとうございます。返信が遅くなり、すいません。
なお書きの意味が分かり辛かったですね。
B列に「●」を表示するのではなく、A列に記載され、検索されたB、D、Z
の前に「●」が表示される感じです。
例）●B
記載されたマクロは正常に動きましたが、追加の内容ではどの様になりますでしょうか。
もし、可能であれば回答お願い致します。無知ですいません。

お礼日時：2015/06/03 21:41

No.2 回答者： keronjin 回答日時： 2015/06/01 22:12

流れ図を書くとわかりやすいと思いますよ。

　　　　　　セルA1にカーソルを移動
　　　　　　　　　　 ↓
→→ セルに入っている文字列に●が含まれているか？
↑　　　　　　↓　　　　　　　↓
↑　　　　　 Yes　　　　　　　No
↑　　　　　　↓　　　　　　　↓
↑　　　　　　↓　　　B、D、Zなら●を加える。
↑　　　　　　↓　　　　　　　↓
↑　　　　　　↓　　　　　　　↓
↑　　　　　　セルを一つ下に移動。
↑　　　　　　　　　　↓
↑←行数分繰り返し←←←

※ セルA1から下方向へ順番に検索して空白セルになるまで繰り返します。
※ 文字列の大文字・小文字の判定はしていません。この例では半角大文字だけを認識します。


Sub Macro1()
' エクセルで複数の文字を検索し、その文字に特定文字を付与する
Dim i As Long, moji As String
Range("A1").Select
i = 1
Do Until Cells(i, 1) = ""
moji = ActiveCell.Value
If InStr(moji, "●") > 0 Then GoTo Continue
If InStr(moji, "B") > 0 Then ActiveCell.Value = moji + "●"
If InStr(moji, "D") > 0 Then ActiveCell.Value = moji + "●"
If InStr(moji, "Z") > 0 Then ActiveCell.Value = moji + "●"
Continue:
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
End Sub

この回答へのお礼

回答ありがとうございます。お礼が遅くなりすいません。
回答頂いたマクロで正常に動きましたが、A列の任意の行から検索される様にしたいです。
どの様にしたら宜しいでしょうか。
持てる知識は活用したのですが、上手く出来ませんでしたので、回答頂けると幸いです。

お礼日時：2015/06/03 21:39

No.3 回答者： tom04 回答日時： 2015/06/03 22:13

No.1です。

↓のコードに変更してみてください。

Sub Sample2()
Dim k As Long, c As Range, myAry As Variant
myAry = Array("B", "D", "Z")
For k = 0 To UBound(myAry)
Set c = Range("A:A").Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not c Is Nothing Then
c = "●" & c
End If
Next k
End Sub

※　A列の最初から検索しています。

尚、No.2さんの方に
＞A列の任意の行から検索される様にしたいです。
とありますので、余計なお世話かもしれませんが、
A列のあるセルを選択し、そのセル以降で最初にヒットした場合のコードも載せておきます。

Sub Sample3()
Dim k As Long, lastRow As Long
Dim c As Range, myArea As Range, myAry As Variant
myAry = Array("B", "D", "Z")
lastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set myArea = Range(Cells(Selection.Row, "A"), Cells(lastRow, "A"))
For k = 0 To UBound(myAry)
Set c = myArea.Find(what:=myAry(k), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not c Is Nothing Then
c = "●" & c
End If
Next k
End Sub

これで選択セル以降が検索対象となります。

※　今回はどちらも大文字・小文字を区別していますので、
途中に小文字のアルファベットがあってもスルーされます。m(_ _)m

この回答へのお礼

回答ありがとうございます。
目的を達成することが出来ました。感謝です。
今後、マクロについて勉強したいと思います。

お礼日時：2015/06/04 20:06

No.4 回答者： keronjin 回答日時： 2015/06/03 23:50

No,2です。

今回、質問者さんがVBAについてまだ慣れていらっしゃらないようでしたので
複雑な配列などをごちゃごちゃ書くよりもシンプルな方が良いと思い出来るだけシンプルにしました。
なので、おっしゃるような改造も簡単な書き換えで出来ます。

A列の任意の行から検索される様にしたい、ということは
流れ図の最初、つまり「セルA1にカーソルを移動」という部分が無ければ良いということです。
プログラムでいうと４行目の「 Range("A1").Select 」を削除するだけです。
あらかじめA列の任意のセルをクリックしておいてからこのマクロを実行すればその場所から検索を始めます。

No.5 回答者： keronjin 回答日時： 2015/06/04 00:13

再びNo,2です。

修正した内容です。結果が”B●”となるのを”●B”の形にしました。

Sub Macro1()
' エクセルで複数の文字を検索し、その文字に特定文字を付与する
Dim i As Long, moji As String
i = ActiveCell.Row
Do Until Cells(i, 1) = ""
moji = ActiveCell.Value
If InStr(moji, "●") > 0 Then GoTo Continue
If InStr(moji, "B") > 0 Then ActiveCell.Value = "●" + moji
If InStr(moji, "D") > 0 Then ActiveCell.Value = "●" + moji
If InStr(moji, "Z") > 0 Then ActiveCell.Value = "●" + moji
Continue:
ActiveCell.Offset(1, 0).Select
i = i + 1
Loop
End Sub

この回答へのお礼

丁寧な回答ありがとうございます。
マクロ自体はとても分かりやすいのですが、２５行目までしか機能しません。
２６行目以降にB,D,Zがあっても●が付されない状況です。

お礼日時：2015/06/04 19:55

No.6 回答者： keronjin 回答日時： 2015/06/04 21:19

No,2です。

[２６行目以降にB,D,Zがあっても●が付されない]ということですが、
当方の環境ではNo.5のマクロで何百行でも正しく動作しています。
２６行目以降にB,D,Zがあっても●が付きます。
セル内の文字列に問題がありそうな気がしますが、
その「●が付されない」文字列というのをここに貼ってみてもらえませんか。

No.7 回答者： keronjin 回答日時： 2015/06/04 21:30

No,2です。

何度もすいません。
B,D,Zは半角文字でなければ反応しません。全角で入力されていませんか？。
添付画像のように画面上ではとても区別しにくいのでよく確認してみてください。