VBAマクロで検索をしたい

質問

VBAマクロで検索をしたい

１つの列に8～11桁の数字がならんでいます。
別シートに検索シートを作り、下４桁（右から４桁）で抽出したすべての数字を出すにはどうしたらいいでしょうか？＞＜；

例）
　シート１
　　A列
1　0001234555
2　12345678　
3　3211234555
4　987654321
5　3211234555
6　1111114555
7　12344555
8　あ123い4555

　シート２
　A列検索
　4555　←　入力
　　↓以下が検索される
　0001234555
　3211234555
　3211234555
　1111114555
　12344555
　あ123い4555

※同じ数字が並ぶ場合もあり、その場合は複数あることを示すため、その個数分出して欲しい。
※右４桁は数字のみだがそれ以外はひらがな、カタカナが入る場合がある

どなたか教えてください＞＜；

回答No.1

fujillin · ベストアンサー

シート2のA1に検索値が入力されていて、結果をA3から下に書き出すと仮定して…
こんなかんじでしょうか？（桁数は特に制限していません）

Sub sample()
　Dim sht As Worksheet, sorceRng As Range, destRng As Range
　Dim rMax As Long, str As String, L As Integer

　Const sorceSht = "シート1" ' データシート名
　Const destSht = "シート2"　'検索シート名

　Set sht = Worksheets(sorceSht)　　'データシートを取得
　Set sorceRng = sht.Cells(1, 1)　　'A1セルを取得
　rMax = sht.Cells(Rows.count, 1).End(xlUp).Row 　'A列の最終行を取得
　Set destRng = Worksheets(destSht).Cells(3, 1) 　'検索シートのA3セル（書出し位置）
　destRng.Resize(Rows.count - 2, 1).ClearContents 　'検索結果表示範囲をクリア
　str = destRng.Offset(-2, 0).Text　 '検索文字列（A1セルの値）

　If str = "" Then Exit Sub
　L = Len(str)
　While sorceRng.Row <= rMax
　　If Right(sorceRng.Text, L) = str Then
　　　destRng.Value = sorceRng.Text
　　　Set destRng = destRng.Offset(1, 0)
　　End If
　　Set sorceRng = sorceRng.Offset(1, 0)
　Wend
End Sub

お礼

遅くなりましたが、ありがとうございました。
自分のマクロに書き換えてもうまくうごきました＾＾！
ｍ（＿＿）ｍ