Excel VBA質問箱 IV

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

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


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

【62921】検索→行削除→別シートへ行の貼り付け くまけん 09/9/17(木) 13:27 質問[未読]
【62922】Re:検索→行削除→別シートへ行の貼り付け kanabun 09/9/17(木) 13:38 発言[未読]
【62923】Re:検索→行削除→別シートへ行の貼り付け kanabun 09/9/17(木) 13:59 発言[未読]
【62924】Re:検索→行削除→別シートへ行の貼り付け くまけん 09/9/17(木) 14:22 お礼[未読]

【62921】検索→行削除→別シートへ行の貼り付け
質問  くまけん  - 09/9/17(木) 13:27 -

引用なし
パスワード
   わたくし、VBAは超初心者で、参考書を見ておりますが、
全くと言って良いほど解りません。どなたか教えてください。

20項目が並ぶExcel-Sheet1があり、そのA列の項目には名前が入力してあります。
その”名前”の数万行には例えば、「森田一義」や「四角株式会社」、
「日本寺」などがあるため、”株式会社”や”寺”で検索を行って、
そのヒットした部分の「Sheet1の行」を削除し、
その行をSheet2に上から順に貼り付けていきたいのです。

また、文字列の検索には「Input Box」を使用したいと思っておりますが、
その場合のVBAの記述は、どのようになるのでしょうか。
宜しくお願い致します。

【62922】Re:検索→行削除→別シートへ行の貼り付け
発言  kanabun  - 09/9/17(木) 13:38 -

引用なし
パスワード
   ▼くまけん さん:

>20項目が並ぶExcel-Sheet1があり、そのA列の項目には名前が入力してあります。
>その”名前”の数万行には例えば、「森田一義」や「四角株式会社」、
>「日本寺」などがあるため、”株式会社”や”寺”で検索を行って、
>そのヒットした部分の「Sheet1の行」を削除し、
>その行をSheet2に上から順に貼り付けていきたいのです。

まず、
対象シートの A列に
> ”株式会社”や”寺”で
AutoFilterかけて、表範囲を(ただし1行目=見出し行を除く)
別シートの最終行の1つ下の行にコピーする操作を
マクロ記録してみてはどうですか?

【62923】Re:検索→行削除→別シートへ行の貼り付け
発言  kanabun  - 09/9/17(木) 13:59 -

引用なし
パスワード
   ▼くまけん さん:

>その”名前”の数万行には例えば、「森田一義」や「四角株式会社」、
>「日本寺」などがあるため、”株式会社”や”寺”で検索を行って、
>そのヒットした部分の「Sheet1の行」を削除し、
>その行をSheet2に上から順に貼り付けていきたいのです。

行削除の件ですが、
フィルタされた可視行だけをCutして別シートに移動しようとしても、
表全体がCutされてしまうので、
可視行を別シートにCopyしておいてから、可視行をDeleteする
という方法を用います。
  フィルタをかける表のあるシート Worksheets(1)
  コピー先シート         Worksheets(2)
としますと、 

Sub Test2b()
 Dim CopyTo As Range
 Dim StrInput As String
 StrInput = InputBox("抽出文字列")
 If StrPtr(StrInput) = 0& Then Exit Sub
 StrInput = "*" & StrInput & "*"
 
 Set CopyTo = Worksheets(2).Range("A65536").End(xlUp).Offset(1) 'コピー先
 
 With Worksheets(1).Range("A1").CurrentRegion 'フィルタ範囲
   .AutoFilter 1, StrInput          'A列にフィルタをかける
   With Intersect(.Cells, .Offset(1))  '見出し行を除く抽出データ
     .Copy CopyTo           '別シートにコピー
     .Columns(1).EntireRow.Delete   '抽出行を削除
   End With
   .AutoFilter
 End With

End Sub

【62924】Re:検索→行削除→別シートへ行の貼り付け
お礼  くまけん  - 09/9/17(木) 14:22 -

引用なし
パスワード
   ▼kanabun さん:

早々の回答をありがとうございます。
マクロで試してみていたところ、再度、VBAの記述をして頂き、
感謝しております。

kanabunさんのをコピペして試してみましたら、
間違いなくわたくしが求めているものです。
来週末までに数十万件の行を確認していかなければならないため、
本当に困惑していた次第です。ありがとうございました。

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