Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12532 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【9996】該当する住所データを抽出 igusukei 03/12/28(日) 16:02 質問
【9998】Re:該当する住所データを抽出 Asaki 03/12/28(日) 17:51 回答
【9999】Re:該当する住所データを抽出 igusukei 03/12/28(日) 21:08 質問
【10002】Re:該当する住所データを抽出 Jカーター 03/12/29(月) 6:46 発言
【10003】Re:該当する住所データを抽出 igusukei 03/12/29(月) 8:45 質問
【10004】Re:該当する住所データを抽出 igusukei 03/12/29(月) 8:49 質問
【10011】Re:該当する住所データを抽出 Asaki 03/12/29(月) 17:27 回答
【10012】Re:該当する住所データを抽出 igusukei 03/12/29(月) 19:28 質問
【10013】Re:該当する住所データを抽出 Jカーター 03/12/30(火) 7:02 回答
【10021】Re:該当する住所データを抽出 igusukei 03/12/30(火) 18:16 質問
【10022】Re:該当する住所データを抽出 Jカーター 03/12/30(火) 22:42 回答
【10039】Re:該当する住所データを抽出 igusukei 04/1/4(日) 21:03 質問
【10043】Re:該当する住所データを抽出 Jカーター 04/1/5(月) 7:45 回答
【10042】Re:該当する住所データを抽出 とまと 04/1/4(日) 23:30 回答
【10044】Re:該当する住所データを抽出 Jカーター 04/1/5(月) 7:56 発言
【10052】Re:該当する住所データを抽出 とまと 04/1/5(月) 14:46 回答
【10063】Re:該当する住所データを抽出 igusukei 04/1/5(月) 21:28 お礼
【10064】Re:該当する住所データを抽出 Jカーター 04/1/5(月) 21:47 発言
【9996】該当する住所データを抽出
質問  igusukei  - 03/12/28(日) 16:02 -
引用なし
パスワード
   sheet1 に住所録があり、内容は
　 A　　　 B　　　 C　　　　　　D　　　　　 E
1 名前　　 読み　　電話番号　　郵便番号　 　 住所
2 佐藤○夫 サトウ　03-00-1111 141-1111　東京都港区・・・
からなる1000件ほどのデータがあり、この中で名前に付いて抽出したいと思っています。
そこで sheet2 セルB2に名前を入力し、マクロ実行ボタンを押すとセルA5より下に、該当する住所データを表示させたい。
なお、性だけで検索した場合、同じ性の人が複数いるので、その数だけ表示したい。最大15件ほどです。

sheet2
　　A　　B　　　C　　　　 D　　　 E
1
2 名前 [　　]　[検索]
3
4 名前　 読み　電話番号　郵便番号　住所　
5
6
7
8
よろしくお願いします。
【9998】Re:該当する住所データを抽出
回答  Asaki  - 03/12/28(日) 17:51 -
引用なし
パスワード
   こんにちは。

Sheet2のレイアウトをちょっとだけ変えて
A列2行目に条件を入力
A列5行目から結果を表示
と言う風にして、フィルタオプションを使用する方法です。

Sub test()
　　Dim rng　　　　 As Range

　　With Worksheets("Sheet1")
　　　　Set rng = .Range("A1", .Cells(.Rows.Count, 5).End(xlUp))
　　End With
　　With Worksheets("Sheet2")
　　　　.Range("A5", .Cells(.Rows.Count, 5).End(xlUp)).ClearContents

　　　　rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
　　　　　　"A2:A3"), CopyToRange:=.Range("A5"), Unique:=False
　　End With
　　Set rng = Nothing
End Sub
【9999】Re:該当する住所データを抽出
質問  igusukei  - 03/12/28(日) 21:08 -
引用なし
パスワード
   asakiさん早速ありがとうございます。
説明が間違っていた所がありました、項目の初めに番号がありました。
従って
番号　名前　読み　電話番号　郵便番号　住所　の６項目でした
それで、　Cells(.Rows.Count, 5) の 5 を 6 にして
名前ではなく、番号で検索して見ましたが、大量に表示しました。（該当以外も表示した）
名前で検索するには何処を変更すればいいでしょうか？
また、終わってから表示したデータをクリアするにはどうしたらいいでしょう？
よろしくお願いします。

Sub test()
　　Dim rng　　　　 As Range

　　With Worksheets("Sheet1")
　　　　Set rng = .Range("A2", .Cells(.Rows.Count, 6).End(xlUp))
　　End With
　　With Worksheets("Sheet2")
　　　　.Range("A5", .Cells(.Rows.Count, 6).End(xlUp)).ClearContents

　　　　rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
　　　　　　"A2:A3"), CopyToRange:=.Range("A5"), Unique:=False
　　End With
　　Set rng = Nothing
End Sub
【10002】Re:該当する住所データを抽出
発言  Jカーター  - 03/12/29(月) 6:46 -
引用なし
パスワード
   おじゃまします。
フィルタオプションのコピーモードでは
抽出範囲にタイトルを設定しておいて
その範囲を指定するコードにすると前に抽出したデータを消す必要がありません。

たとえば
Sheet2のA5:F5に
番号　名前　読み　電話番号　郵便番号　住所
としておいて
, CopyToRange:=.Range("A5:F5"),
とするとその前のClearContentsは不要と思います。
ちなみに
タイトルは順番を変えたり、取り出したいタイトルだけ
書いておくとその通りに抽出されて便利です。

おじゃましました。
【10003】Re:該当する住所データを抽出
質問  igusukei  - 03/12/29(月) 8:45 -
引用なし
パスワード
   Jカーターさんありがとうございます。
初心者の私にとって、ただ教わった通りにしか出来ません
以下のように書き換えました。
実際のデータはこの様になっています(sheet1)
　 A　　　　 B　　　 C　　　　D　　　　　E　　　　 F
2 番号　 　名前　　 読み　 電話番号　 郵便番号　 住所
3 101　　佐藤○雄　サトウ　03-11-211　114-0124　 東京都港区・・・
4 102

sheet2 のA2に 101 を入力してマクロを実行すると、101のデータだけではなく
102〜610 位まで全て表示します。別の番号を入れても結果は同じです。
また名前で検索するにはどうしたらいいでしょうか。
よろしくお願いします。

Sub search_dat()
　　Dim rng　　　　 As Range

　　With Worksheets("data")
　　　　Set rng = .Range("A2", .Cells(.Rows.Count, 6).End(xlUp))
　　End With
　　With Worksheets("search")
　　　　.Range("A5", .Cells(.Rows.Count, 6).End(xlUp)).ClearContents

　　　　rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Range("A5:F5"), Unique:=False
　　End With
　　Set rng = Nothing
End Sub
【10004】Re:該当する住所データを抽出
質問  igusukei  - 03/12/29(月) 8:49 -
引用なし
パスワード
   済みません、work sheet の名前を間違えました。
実際につかっているsheet名でした。
data→sheet1
search→sheet2
の間違いです (^^;
【10011】Re:該当する住所データを抽出
回答  Asaki  - 03/12/29(月) 17:27 -
引用なし
パスワード
   こんにちは。
時間がなかったので、あまり検証していませんでした。

取り敢えず、先頭に番号が付くとのことですので、
下記ではいかがでしょうか？

Sub search_dat()
　　Dim rng　　　　 As Range

　　With Worksheets("data")
　　　　Set rng = .Range("A1", .Cells(.Rows.Count, 6).End(xlUp))
　　End With
　　With Worksheets("search")
　　　　rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
　　　　　　"A2:B3"), CopyToRange:=.Range("A5:F5"), Unique:=False
　　End With
　　Set rng = Nothing
End Sub

全部のデータが検索されてしまった原因は、CriteriaRange　の指定がなかったためと思われます。
【10012】Re:該当する住所データを抽出
質問  igusukei  - 03/12/29(月) 19:28 -
引用なし
パスワード
   asakiさんありがとうございます
早速試しましたが、やはり前回と同じく全データが表示されてしましました。
（正確には472行まであるデータのうち、405行まで表示）
マクロを実行すると一旦クリアーしてすぐに表示します。
なにぶん初心者ゆえ、マクロの記録が悪いのか操作が悪いのか・・・？
このマクロでは１番目の項目（番号）を検索するのですよね？
もし２番目の項目、名前について検索する場合はどこを変えればいいのでしょう？
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=.Range( _
　　　　　　"A2:B3"), CopyToRange:=.Range("A5:F5"), Unique:=False
の"A2:B3"は何の範囲でしょう？
何から何まで済みません、もう少しと言う感じがしているのですが、よろしくお願いします。
【10013】Re:該当する住所データを抽出
回答  Jカーター  - 03/12/30(火) 7:02 -
引用なし
パスワード
   こんにちは。
番号だけを条件にするなら
Sheet2のA1:A2を条件を指定する範囲として
======================================================================
'Sheet1
'　　A　　　　B　　　　C　　　　D　　　　　E　　　　F
'1　番号　 　名前　　 読み　 電話番号　 郵便番号　 住所
'2　　-------データ------------------------------------
'----------------------------------------------------------
'Sheet2
'　　A　　　　B　　　　C　　　　D　　　　　E　　　　F
'1　番号
'2　101
'3
'4
'5　番号　 　名前　　 読み　 電話番号　 郵便番号　 住所
'6
'----------------------------------------------------------
Sub test()
　　With Sheets("Sheet2")
　　　　Sheets("Sheet1").Cells(1 _
　　　　　　).CurrentRegion.AdvancedFilter xlFilterCopy, _
　　　　　　　　.Range("A1:A2"), .Range("A5:F5")
　　End With
End Sub

違ったらすいません。
【10021】Re:該当する住所データを抽出
質問  igusukei  - 03/12/30(火) 18:16 -
引用なし
パスワード
   Ｊカータさんありがとう！
出来ました！

いろいろと試して見ましたが、問題発生しました。
データの一部の文字列で検索をした場合にＮＧです
例えば：名前に　(株)山田商会　があり
(株)で検索するとＯＫですが、山田商会　だとＮＧです
この様にデータの一部でも検索出来ないでしょうか？
年越しになりますが、気長にお付き合いお願いします。
急ぎませんのでよろしく
【10022】Re:該当する住所データを抽出
回答  Jカーター  - 03/12/30(火) 22:42 -
引用なし
パスワード
   こんばんは。

検索値を入力するとき
*山田商会*

とすればいいと思います。

>気長にお付き合いお願いします。
>急ぎませんのでよろしく

できれば速く解決してください。
【10039】Re:該当する住所データを抽出
質問  igusukei  - 04/1/4(日) 21:03 -
引用なし
パスワード
   ▼Jカーター さん：ありがとうございます。

>検索値を入力するとき
>*山田商会*
出来ました！
毎回"*"を入力しないで、あらかじめプログラムに入れて置くことは出来ませんでしょうか？
半角"*" 全角"検索文字列" 半角"*" 結構面倒・・・
お手数ですがよろしくお願いいたします。

>できれば速く解決してください。
はい！　済みません、教えていただく人のことを考えずに失礼しました。
実は３１日から４日まで旅行へ行っていたもんで済みません。
よろしく〜
【10042】Re:該当する住所データを抽出
回答  とまと  - 04/1/4(日) 23:30 -
引用なし
パスワード
   こんばんは

sheet2 の　A2セルの値でデータを抽出します


Sub 抽出()


Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
　　
　　
　　MyR = sh2.Range("a2")
　　　
　　sh2.Range("a6:e65536").ClearContents
　　　
　　With sh1.Range("a1").CurrentRegion
　　　　.AutoFilter 1, "*" & MyR & "*"
　　　　If .Columns(1).Rows.Count = 1 Then
　　　　　MsgBox "該当データはありません"
　　　　Else
　　　　 .Offset(1).Copy sh2.Range("a6")
　　　　End If
　　　　.AutoFilter
　　End With

Set sh1 = Nothing
Set sh2 = Nothing


End Sub
【10043】Re:該当する住所データを抽出
回答  Jカーター  - 04/1/5(月) 7:45 -
引用なし
パスワード
   こんにちは。
抽出コピーを同時にできる
前の抽出された値を自動で消せる
などフィルタオプションは捨てがたいですね
そこで
A2セルの値の前後に*をつける作業をして
フィルタ実行後に"*"を消してしまうのはどうでしょう？
------------------------------------------------------------------------
Sub test()
　　With Sheets("Sheet2")
　　　　.Range("A2").Value = "*" & .Range("A2").Value & "*"
　　　　Sheets("Sheet1").Cells(1 _
　　　　　　).CurrentRegion.AdvancedFilter xlFilterCopy, _
　　　　　　　　.Range("A1:A2"), .Range("A5:F5")
　　　　.Range("A2").Replace "~*", "", xlPart
　　End With
End Sub

違ったらすいません。
【10044】Re:該当する住所データを抽出
発言  Jカーター  - 04/1/5(月) 7:56 -
引用なし
パスワード
   こんにちは。
あの、大変失礼ですが
>If .Columns(1).Rows.Count = 1 Then
これで抽出数は数えられないと思います。
(フィルタを実行する範囲の行数がいつもかえりませんか?)
あと
変数宣言を忘れてますよ。


勘違いならすいません。
【10052】Re:該当する住所データを抽出
回答  とまと  - 04/1/5(月) 14:46 -
引用なし
パスワード
   こんにちは

>あの、大変失礼ですが
>>If .Columns(1).Rows.Count = 1 Then
>これで抽出数は数えられないと思います。

ご指摘のとおりですスミマセン (^^;;
少し修正しました


Sub 抽出2()

Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim MyR As Range


Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
　
　　Set MyR = sh2.Range("a2")
　　
　　If MyR.Value = "" Then
　　　 MsgBox "A2値を入れてください"
　　　 Exit Sub
　　End If
　　
　　sh2.Range("a6:e65536").ClearContents
　
　
　　With sh1.Range("a1").CurrentRegion
　　　　.AutoFilter 1, "*" & MyR.Value & "*"
　　　　If .Columns(1).SpecialCells(xlCellTypeVisible).Count = 1 Then
　　　　　MsgBox "該当データはありません"
　　　　Else
　　　　 .Offset(1).Copy sh2.Range("a6")
　　　　End If
　　　　.AutoFilter
　　End With

Set sh1 = Nothing
Set sh2 = Nothing
Set MyR = Nothing

End Sub
【10063】Re:該当する住所データを抽出
お礼  igusukei  - 04/1/5(月) 21:28 -
引用なし
パスワード
   Ｊカーターさん
とまとさん
ありがとうございます。

Ｊカーターさんの "*" が自動で付くのはいいですね
とまとさんの試して見ましたMsgBoxなど細かい配慮いいですね
検索速度がＪカーターさんのに比べるとかなり遅いのですが、どうしててでしょう？
二人のを合わせて出来ないかと、とまとさんのMsgBoxとＪカーターさんの組み合わせてやてみます。

これで私の目的は達成できたと思います。
本当にありがとうございました。感謝いたします。
【10064】Re:該当する住所データを抽出
発言  Jカーター  - 04/1/5(月) 21:47 -
引用なし
パスワード
   こんばんは。
オートフィルタを使う場合は
１，条件に一致した行以外を不可視にします。
２，可視セルのみをコピー
３，フィルタを解除
と３段階の処理となります。

それに比べてフィルタオプションのコピーモードは
一気にコピーまで処理を行えます。

それ以外にも
列を並び替えて抽出とか必要な列のみ抽出などもできます。
前に抽出したデータを消さなくても置き換えられます。
抽出条件を細かい設定できます(条件に数式が使えます)
しかも高速
などかなりのメリットがあります。
コピペが前提のフィルタならこちらがベストです。

ちなみに
メッセージを出すなら
抽出先に指定したセル範囲の一個下のセル(Sheet2!A6)の
入力状態をみればいいかもしれません。
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム  
12532 / 13646 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
2610219
(SS)C-BOARD v3.8 is Free