Excel VBAでサーチを使った分類をする方法を教えてください。

質問

こんばんは。
下記のような名前がB列にあるとします。
-------------
こまったパンダ
ころげおちたパンダ山
コンビにモンキー
きっとあるよねパンダ団子・・・
羽鳥ツバメ
------------
この文字列の中からパンダを含んだ場合、「Aパンダ」。モンキーを含んだ場合、「Bモンキー」。含まない場合は、「Cその他」とA列に分類する項目を設け、VBAで転記さたいのですが、どのように記述したらよいのでしょうか。
できればSheet2に分類表を設け「パンダ」を含んだら「パンダA」に分類というふうに出来ればベストです。
難しい場合は、考え方だけでも教えていただけると助かります。
宜しくお願い致します。

回答No.3

n-jun · ベストアンサー

n-junです。

＞Cその他　　"　"
「Cその他」のＢ列には"　"ではなく、何も代入されていない状態とします。

Sub　try()
　Dim　r　As　Range,　rf　As　Range
　Dim　r1　As　Range,　r2　As　Range
　Dim　myAdd　As　String

　With　Worksheets("Sheet1")
　　　　　　Set　r1　=　.Range(.Range("B1"),　.Cells(Rows.Count,　2).End(xlUp))
　End　With

　With　Worksheets("Sheet2")
　　　　　　Set　r2　=　.Range(.Range("B2"),　.Cells(Rows.Count,　2).End(xlUp))
　End　With

　For　Each　r　In　r2
　　　　　Set　rf　=　r1.Find(What:=r.Value,　After:=r1.Item(1),　LookIn:=xlValues,　LookAt:=xlPart)
　　　　　If　Not　rf　Is　Nothing　Then
　　　　　　　　myAdd　=　rf.Address
　　　　　　　　Do
　　　　　　　　　　　　　rf.Offset(,　-1).Value　=　r.Offset(,　-1).Value
　　　　　　　　　　　　　Set　rf　=　r1.FindNext(rf)
　　　　　　　　Loop　Until　myAdd　=　rf.Address
　　　　　End　If
　　　　　Set　rf　=　Nothing
　Next
　If　Application.CountBlank(r1.Offset(,　-1))　>　0　Then
　　　　r1.Offset(,　-1).SpecialCells(xlCellTypeBlanks).Value　=　r2.Item(r2.Cells.Count).Offset(1,　-1).Value
　End　If
End　Sub

勘違いしていたらごめんなさい。

お礼

なんとなく感じがつかめました。
データを検索するためにFind(What:=r.Value,　After:=r1.Item(1),　LookIn:=xlValues,　LookAt:=xlPart)を使えば良いのですね。
ありがとうございました。

回答No.2

kmetu

Sub test()

Dim MyRange As Range

For Each MyRange In Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row)
If MyRange Like "*" & "パンダ" & "*" Then
Worksheets("sheet2").Cells(1, Worksheets("sheet2").Cells(1, Columns.Count).End(xlToLeft).Column + 1).Value = MyRange.Value
ElseIf MyRange Like "*" & "モンキー" & "*" Then
Worksheets("sheet2").Cells(2, Worksheets("sheet2").Cells(2, Columns.Count).End(xlToLeft).Column + 1).Value = MyRange.Value
Else
Worksheets("sheet2").Cells(3, Worksheets("sheet2").Cells(3, Columns.Count).End(xlToLeft).Column + 1).Value = MyRange.Value
End If
Next

End Sub

でいかがでしょう

回答No.1

n-jun

＞A列に分類する項目を設け、VBAで転記さたいのですが、
＞できればSheet2に分類表を設け「パンダ」を含んだら「パンダA」に分類というふうに出来ればベストです。
求めている結果を具体的に提示されると良いかもしれません。
どのシートのどこのセルに、どのような条件を与えてどのような結果を表示したいか等々。

補足

今考えていることは、
Sheet1のA列に分類（空欄）。B列に名前。
Sheet2に分類をしたい表。
A列　　　　B列
分類　　　 ○○を含む
Aパンダ　　パンダ
Bモンキー　モンキー
Cその他　　"　"
本来なら、Sheet2の表を見ながらまたは、Sheet1のA列をプルダウン化してSheet1のB列が○○だったら、これはA、これはBとそれぞれを分類していくのでしょうが、毎月分類して、集計していかなければならなくなりました。分類だけ出来ればSUMIFで集計できそうだと考えています。
お知恵をお願い致します。