エクセル データ転記について

皆さま、こんにちは。
表題の件について、vbaに詳しい方のお知恵をお借りしたいです。

Sheet 1の2行目から50行目までの間に下記データが入力されているとします。
(例) A1セル 商品名 B1セル 地域 C1セル 在庫 D1セル 金額

____A_____B____C____D___
1 商品名 地域 在庫 金額
2 麦茶 池袋 あり 2000
3 緑茶 新宿 なし 1500
4 コーヒー 品川 なし 500
5 烏龍茶 新宿 あり 3000
6 紅茶 池袋 なし 1500
7 コーヒー 品川 あり 600
8 緑茶 新宿 なし 1500
9 緑茶 池袋 あり 500
10 紅茶 品川 なし 700


これらのデータを品川、新宿、池袋の地域別にまとめ、Sheet 2のA2セルへ商品、B2セルへ地域、C2セルへ在庫を(上から品川、新宿、池袋の順に)、マクロボタンをクリックするだけでデータ転記されるようなvbaコードのご教授願います。
データの入力については2行目から50行目までの間で可変します。
また、D例にある金額については転記の必要はありません。
現状は、フィルターで品川、新宿、池袋の地域別にソートをかけてコピー貼り付けをしています。

皆さま何卒宜しくお願い致します。

No.5 ベストアンサー 回答者： tom04 回答日時： 2020/06/24 14:39

こんにちは！

地域が三つだけなら他の方が回答されているようにわざわざVBAでやらなくてもいけそうな気がしますが、
VBAをご希望というコトなので、一例です。
尚、両シートとも１行目は項目行になっているという前提です。

↓のコードを標準モジュールにしてください。

Sub Sample1()
　Dim k As Long, lastRow As Long
　Dim wS As Worksheet
　Dim myAry

　　myAry = Array("品川", "新宿", "池袋") '//←地域名が増えたらここに追加//
　　Set wS = Worksheets("Sheet2")
　　　Application.ScreenUpdating = False
　　　　'//▼Sheet2のデータを一旦消去//
　　　　lastRow = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　　If lastRow > 1 Then
　　　　　　Range(wS.Cells(2, "A"), wS.Cells(lastRow, "C")).ClearContents
　　　　　End If
　　　　'//▼ココから操作//
　　　　With Worksheets("Sheet1")
　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　For k = 0 To UBound(myAry)
　　　　　　　.Range("A1").AutoFilter field:=2, Criteria1:=myAry(k)
　　　　　　　If .Cells(Rows.Count, "A").End(xlUp).Row > 1 Then
　　　　　　　　Range(.Cells(2, "A"), .Cells(lastRow, "C")).SpecialCells(xlCellTypeVisible).Copy _
　　　　　　　　　wS.Cells(Rows.Count, "A").End(xlUp).Offset(1)
　　　　　　　End If
　　　　　　Next k
　　　　　　.AutoFilterMode = False
　　　　End With
　　　　wS.Activate
　　　Application.ScreenUpdating = True
　　　　MsgBox "完了"
End Sub

※　＞ボタンを押下するだけの簡単に出来ないかものかと・・・
手動でマクロを実行するのではなく、ワンクリック（コマンドボタン等）で行いたい場合は
Sheet1にコマンドボタンを配置し

Private Sub CommandButton1_Click()
　Call Sample1
End Sub

でマクロが実行されます。

※　今回はデータ数があまり多くないので、
Sheet2のどこかのセルに「地域名」を入力すればその地域のみだけを表示！
といったコトは関数で可能なので、三つの地域を一度の表示しなくて良いのであれば
そちらの方がいいかも・・・m(_ _)m

この回答へのお礼

tom04様

ご親切に完成コードまで提示して頂きありがとうございました。おかげさまで、無事に出来ました。
また、貴重なアドバイスについても、重々お礼申し上げます。
本当にありがとうございました。

お礼日時：2020/06/25 18:51

No.4 回答者： d-q-t-p 回答日時： 2020/06/24 14:22

画面のちらつきは単純に画面更新を止めてないだけだと思います。

ただそれにしてもいちいち３回抽出するんじゃなくて 地域ごとに番号
を振ってソートしてやった方が早いでしょう。

あと Excel2013なら データの取得と変換機能（クエリ）があります。

・Sheet1の表（テーブル1）を読み込む
・カスタム列（「順番」）に ifで地域に番号を振る
　= if [地域] = "品川" then 1 else (if [地域] = "新宿" then 2 else (if [地域] = "池袋" then 3 else 4))
・順番列を昇順にソート
・「順番」「金額」列を削除して読み込み

でいいはず。

地域がもっとたくさんある場合は テーブル2にマスタを作っておいて
マージすればいいです。そっちの方がむしろ簡単です。

使う人がデータの更新すらできないなら 更新ボタンくらい入れてもい
いでしょうけど。

No.3 回答者： banzaiA 回答日時： 2020/06/24 12:04

filter(a2:d50,b2:b50="品川","")

filter(a2:d50,b2:b50="新宿","")
filter(a2:d50,b2:b50="池袋","")
の3行で足りるのに、VBAでする意味がわからない。
ただしヴァージョン365ですが。

この回答へのお礼

banzaiA様

お返事ありがとうございます。
老人ばかりなので、ボタンを押下するだけの簡単に出来ないかものかと考えていました。
バージョンはエクセル2013です。

お礼日時：2020/06/24 12:17

No.2 回答者： fujillin 回答日時： 2020/06/24 11:42

No1です。

＞画面のちらつきが気になったので、この度質問させて頂きました。
問題がそこだけであるなら、マクロ実行中の間だけ「画面の更新」を停止しておけばよろしいでしょう。
https://docs.microsoft.com/ja-jp/office/vba/api/ …

この回答へのお礼

fujillin様

的確なアドバイスありがとうございました。

お礼日時：2020/06/25 18:54

No.1 回答者： fujillin 回答日時： 2020/06/24 10:28

こんにちは

＞現状は、フィルターで品川、新宿、池袋の地域別にソートをかけてコピー貼り付けをしています。
50行までの固定で良いみたいなので、そのままを「マクロの記録」で作成して使いまわせばよさそうに思います。

この回答へのお礼

fujillin様

早速のお返事ありがとうございました。
実は初めにマクロの記録でやってみたのですが、画面のちらつきが気になったので、この度質問させて頂きました。

お礼日時：2020/06/24 10:52