Excel VBA質問箱 IV

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

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


12530 / 13644 ツリー ←次へ | 前へ→

【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さん早速ありがとうございます。
説明が間違っていた所がありました、項目の初めに番号がありました。
従って
番号 名前 読み 電話番号 郵便番号 住所 の6項目でした
それで、 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行まで表示)
マクロを実行すると一旦クリアーしてすぐに表示します。
なにぶん初心者ゆえ、マクロの記録が悪いのか操作が悪いのか・・・?
このマクロでは1番目の項目(番号)を検索するのですよね?
もし2番目の項目、名前について検索する場合はどこを変えればいいのでしょう?
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 -

引用なし
パスワード
   Jカータさんありがとう!
出来ました!

いろいろと試して見ましたが、問題発生しました。
データの一部の文字列で検索をした場合にNGです
例えば:名前に (株)山田商会 があり
(株)で検索するとOKですが、山田商会 だとNGです
この様にデータの一部でも検索出来ないでしょうか?
年越しになりますが、気長にお付き合いお願いします。
急ぎませんのでよろしく

【10022】Re:該当する住所データを抽出
回答  Jカーター  - 03/12/30(火) 22:42 -

引用なし
パスワード
   こんばんは。

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

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

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

できれば速く解決してください。

【10039】Re:該当する住所データを抽出
質問  igusukei  - 04/1/4(日) 21:03 -

引用なし
パスワード
   ▼Jカーター さん:ありがとうございます。

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

>できれば速く解決してください。
はい! 済みません、教えていただく人のことを考えずに失礼しました。
実は31日から4日まで旅行へ行っていたもんで済みません。
よろしく〜

【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 -

引用なし
パスワード
   Jカーターさん
とまとさん
ありがとうございます。

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

これで私の目的は達成できたと思います。
本当にありがとうございました。感謝いたします。

【10064】Re:該当する住所データを抽出
発言  Jカーター  - 04/1/5(月) 21:47 -

引用なし
パスワード
   こんばんは。
オートフィルタを使う場合は
1,条件に一致した行以外を不可視にします。
2,可視セルのみをコピー
3,フィルタを解除
と3段階の処理となります。

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

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

ちなみに
メッセージを出すなら
抽出先に指定したセル範囲の一個下のセル(Sheet2!A6)の
入力状態をみればいいかもしれません。

12530 / 13644 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free