- ベストアンサー
エクセル この場合のVBAの書き方教えてください。
顧客情報がsheet2にデータベース化されていて、そのシートのR列に管理上、属性によって顧客を分類する番号が1から8までそれぞれ入力されています。 教えていただきたいのは、シート1上でその分類の数字を入力すれば、別シート、例えばsheet3にそれに該当する顧客だけをsheet2と同じ書式で自動でコピーしてくれるマクロを作りたいのですが、詳しい方いましたらご面倒でしょうがVBAのコードをそのままコピーできるように書いていただけないでしょうか? 情報が不足でしたら補足させていただきますので宜しくお願いします。
- みんなの回答 (3)
- 専門家の回答
質問者が選んだベストアンサー
簡単なサンプルです。都合により、 >シート1上でその分類の数字を入力すれば... この部分はウインドウから直接入力する方法になっています。ご参考までに。 Sub Sample() Dim rngDB As Range Dim Sh As Worksheet Dim intKey As Integer '元データ範囲 Set rngDB = Sheets("Sheet2").Range("A1").CurrentRegion '分類番号入力 intKey = Int(Application.InputBox( _ Prompt:="分類番号を入力して下さい(1-8)", Type:=1)) If 1 > intKey Or 8 < intKey Then Exit Sub Application.ScreenUpdating = False '転記先初期化 Set Sh = Sheets("Sheet3") Sh.Cells.Clear 'データ抽出&コピー With rngDB .AutoFilter Field:=18, Criteria1:=intKey .SpecialCells(xlCellTypeVisible) _ .Copy Destination:=Sh.Range("A1") .AutoFilter End With Sh.Activate ExitHandler: Application.ScreenUpdating = True Set rngDB = Nothing Set Sh = Nothing End Sub
その他の回答 (2)
- Wendy02
- ベストアンサー率57% (3570/6232)
AdvancedFilterで行うのが良いと思います。 ただし、いくつかの条件があります。 番号 データ1 データ2 ←このようにフィールド行が必要です。 1 a f 2 b b 3 c c 3 c d 3 d e 4 d d 次に、条件検索の検索値には、 番号 ←フィールド行が必要です 2 後は、標準モジュールにでも書いていただければ、良いと思います。 最後に、コピーされる場所は、左端上のセルひとつを指定すればよいです。 Sub Test1() Dim DataRng As Range Dim myCriteria As Range Set DataRng = Worksheets("Sheet2").Range("R1").CurrentRegion 'データ領域 Set myCriteria = Worksheets("Sheet1").Range("C1:C2") '条件検索の検索値 DataRng.AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=myCriteria, _ CopyToRange:=Worksheets("Sheet3").Range("C1"), _ Unique:=False End Sub
お礼
回答ありがとうございました。 無事解決できました。
- KenKen_SP
- ベストアンサー率62% (785/1258)
Sheet2 のR列でオートフィルターを設定し、分類する数字でデータ抽出。その結果をコピーして、Sheet3に貼り付けるれば、良いのではないでしょうか。 マクロでやるのと手間はそう変わらないと思いますよ。
お礼
お礼が遅れまして失礼しました。 随時分類ごとに一覧が出来てくれることが目的でしたのでマクロで出来ないかと質問してみました。 実はマクロや関数といった存在を知ってから1ヶ月あまりでしてオートフィルター?って感じなんですよ。 回答ありがとうございました。
お礼
早速コピーさせていただきました。動作もばっちりです。本当に助かりました。 自分にはどこが簡単なサンプル??ってくらい高度に感じますよ。定期的にエクセルの質問してますのでまたなにかありましたら宜しくお願いいたします。