エクセルVBAで、ある文字を含んでいたら別シートに抽出したい

エクセル2002を使っています。
シート1に
　A列に氏名
　B列に住所
　C列に電話番号　のデータが300件の表があります。

B列を検索してたとえば大阪府があれば、その行（ABC列)をシート２へコピーして抽出したいのです。

　VBAを使ってやりたいのですがどうしたらよいでしょうか?　よろしくお願いします。

No.4 ベストアンサー 回答者： TTak 回答日時： 2003/12/24 10:58

find,findnextメソッドを使った例です。

excel2000で動作確認しました。シート名、検索文字列は適宜変更してください。
データが300件程度なら、この方法でも良いですが、今後増える場合は、次第に時間がかかるようになるのでお勧めできません。

Sub Sample()
Dim c
Dim myr As Integer
Dim myr0 As Integer
With Worksheets(1).Range("B1:B300")
　Set c = .Find("大阪府", LookIn:=xlValues)
　If Not c Is Nothing Then
　　firstAddress = c.Address
　　Do
　　　Set c = .FindNext(c)
　　　myr0 = Range(c.Address).Row
　　　myr = Range(Sheets(2).Cells(Rows.Count, 1) _
　　　　.End(xlUp).Address).Row
　　　Sheets(2).Range("A" & myr + 1 & ":C" & _
　　　　myr + 1).Value = _
　　　　　Sheets(1).Range("A" & myr0 & ":C" & _
　　　　myr0).Value
　　Loop While Not c Is Nothing And c.Address <> firstAddress
　　End If
End With
Set c = Nothing
End Sub

この回答へのお礼

望んでいた通りのことができました。
ありがとうございます。

お礼日時：2003/12/24 16:38

No.7 回答者： 78tch 回答日時： 2003/12/24 11:53

住所に絶対都道府県が入ってるなら、

LEFT(B1,3)
の頭３文字で比較すればいいですね。
ただし「和歌山県」は「和歌山」で抽出ですね。
大阪市とかどういう扱いなのか心配です。

この回答へのお礼

ありがとうございます

お礼日時：2003/12/24 16:36

No.6 回答者： ja7awu 回答日時： 2003/12/24 11:07

条件を設定して使用できるように作ってみました。

どのシートをアクティブにして実行してもＯＫです。
何回実行しても、現データで上書きします。
見出し行があれば、データの上の行だけコピーします。

Sub データ抽出()
'----- 設定事項 ------------
Const OrgSh = "Sheet1" ' <--- 基データのシート名
Const PicSh = "Sheet2" ' <--- 抽出先シート名
Const TopAdd = "B2" '　　<--- 検索範囲の先頭(見出しを除く)
Const FindStr = "大阪府" ' < ---検索する文字列
'---------------------------
Dim Ws1 As Worksheet
Dim Ws2 As Worksheet
Dim Rng As Range
Dim First As String
Dim N As Long
Set Ws1 = Worksheets(OrgSh)
Set Ws2 = Worksheets(PicSh)
Ws2.Cells.ClearContents '抽出先シートをクリア
If Range(TopAdd).Row > 1 Then ' 見出し行があればコピー
　　Ws1.Range(TopAdd).Offset(-1).EntireRow.Copy Destination:=Ws2.Rows(1)
　　N = 1
End If
Set Rng = Ws1.Range(TopAdd).EntireColumn.Find(FindStr) '部分一致検索
If Not Rng Is Nothing Then
　　First = Rng.Address
　　Do
　　　　N = N + 1
　　　　Rng.EntireRow.Copy Destination:=Ws2.Rows(N)
　　　　Set Rng = Ws1.Range(TopAdd).EntireColumn.FindNext(Rng)
　　Loop Until Rng Is Nothing Or Rng.Address = First
End If
End Sub

この回答へのお礼

ありがとうございます

お礼日時：2003/12/24 16:36

No.5 回答者： 78tch 回答日時： 2003/12/24 11:04

あ、よく考えたら住所でソートしてコピペじゃダメすか？どうしてもVBA？

findではB列（住所）に区市町村、番地まで入ってるとどうなるですか？ワイルドカードが使えるのかな（謎）
何が目的かによりますね。

No.3 回答者： 78tch 回答日時： 2003/12/24 10:26

>> 「都道府県」だけを抽出したりと前処理が要るかもです。

→３００件程度とのことですので、私なら、
１．並びに意味があるならA列の前にもう１列挿入して連番を振っておく。
２．住所で並べ替え（ソート）して右端に１列追加して、オートフィルで都道府県名を入力
３．連番で再ソート
という風にやります。
４．もっと件数多ければ→アクセスでやります。

No.2 回答者： 78tch 回答日時： 2003/12/24 10:16

おっと、訂正。

range(cells(1,1),cells(300,4)).advancedfilter xlfiltercopy,Range(Worksheets("シート３").Cells(1,1).value), Worksheets("シート２").Cells(1, 1), False

No.1 回答者： 78tch 回答日時： 2003/12/24 10:14

B列が住所ということは、番地まで入ってるってことですよね。

そのままではツラいかもです。「都道府県」だけを抽出したりと前処理が要るかもです。
D列に都道府県名のみを入れて、シート３のA1に「大阪府」と入れて
range(cells(1,1),cells(300,4)).advancedfilter xlfiltercopy,range
Range(Cells(1, 1), Cells(MyR, 20)).AdvancedFilter xlFilterCopy, Range(Worksheets("シート３").Cells(1,1).value), Worksheets("シート２").Cells(1, 1), False
ぐらいでしょうか。（検証してません。ご参考まで。）