[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『複数条件が一致する値を別ファイルに転記(VBA)』（りんご）
初めまして。
VBAの勉強を始めたばかりで分からない事だらけで恐縮ですが、
下記について教えて下さい。
転記先.xlsmファイルがマクロを記述している開いているBookです。
このファイルの中に、シートが「りんご」、「みかん」、「すいか」とあります。（実際は10個位あるが今回の例題は3つとする）
一方、転記元.xlsxファイルには、シートＡ～複数（今回の例題ではDまでとします）があります。
やりたいことは、
転記元の1行目と転記先の1行目の日付が一致、かつ
転記元のシート名と転記先のA列のA,B,C,D が一致する、かつ
転記元のA列の果物名と転記先のシート名が一致するもの
上記3条件一致するものを、転記先のそれぞれのシートにコピーしてきたいです。
＜転記先.xlsm シート「りんご」の例＞
A B C D E F
1 集計1 2108 2109 2110 2111 2112
2 A
3 B
4 C
5 D
6 集計2
7 A
8 B
9 C
10 D
＜転記元.xlsx シートAの例＞
A B C D E F G H I J K 1 集計1 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2 りんご 5 3 7 8 5 4 1 8 9 0 3 みかん 1 2 2 4 5 1 1 4 5 3 4 すいか 4 5 2 1 4 4 2 2 9 2 5 集計2 6 りんご 1 1 4 8 2 0 9 7 0 9 7 みかん 1 2 2 2 5 1 2 4 5 3 8 すいか 4 1 4 1 8 4 2 3 1 0
＜転記元.xlsx シートBの例＞
A B C D E F G H I J K 1 集計1 2103 2104 2105 2106 2107 2108 2109 2110 2111 2112 2 りんご 2 3 7 8 5 0 0 3 7 8 3 みかん 1 2 2 4 5 1 1 4 5 3 4 すいか 4 5 2 2 4 4 2 2 2 2 5 集計2 6 りんご 4 3 4 8 2 1 4 3 2 1 7 みかん 1 2 2 2 5 1 2 4 5 3 8 すいか 2 1 4 4 4 4 2 3 1 1
マクロ稼働後のイメージ
＜転記先.xlsm シート「りんご」の例＞
A B C D E F
1 集計1 2108 2109 2110 2111 2112
2 A 4 1 8 9 0
3 B 0 0 3 7 8
4 C 2 2 1 2 45
5 D 3 6 9 7 8
6 集計2
7 A 0 9 7 0 9
8 B 1 4 3 2 1
9 C 5 34 6 8 6
10 D 6 45 3 6 78
シート「みかん」「すいか」にも同様に集計したいです。
条件が複雑で、IFでいくのか、Searchやfindで日付が一緒のものを見つけてやったりするのか、配列等を使わないと出来ないのか、
ネットで同じような事例が見つからず困っています。
どうぞ、宜しくお願いいたします。
＜ 使用 Excel：unknown、使用 OS：unknown ＞
ちょっとレイアウトがかわりますが
１）Power Queryで、全データを集約、整形
２）それをピボットテーブルでシートに展開
表示する「果物」と「日付」は、ピボットのフィルターで選択します。
これなら簡単なのですが…
マクロでも実現可能だと思いますが
複雑なロジックになりそうです。
（マナ） 2021/08/28(土) 11:22
こんにちは ＾＾ 興味本位で恐縮ですが、集計1、集計2、の違いって 何なのでしょう、差支えなければ教えて下さい。 なにか、これを作成された元情報、一番最初の入力段階の 日付別売上表[横並びではなく、縦並び] 日付 商品 数 単価 金額 得意先名 備考 2021/3/1 リンゴ 2 380 760 A 集計1 20213/3 みかん 1 150 150 D 集計2 みたいなのが、あれば、そちらから、読み取って処理した方が 便利機能も使えて、早いかも。。。 老人の独り言でした。お聞き流しください。 OSとエクセルバージョンは正確に記入、後だし条件は 止めて、最初からフル条件でご説明賜ると。。。 回答取得率がぐ～～～～んと上がるかもしれません ↑多分。。。＾＾； でわ、頑張ってくださいね。m(_ _)m （隠居Ｚ） 2021/08/28(土) 11:31
隠居Z様
申し訳ありません。
Windows7, Excel2016を使用しています。
集計1、2は、1が生産個数、2が販売個数を意味していると思って下さい。
値は仮で入れたので生産<販売になってしまっているのもありますが、
あくまで集計1と2は別ものを意味しています。
元データ、最終アウトプット形態共に横並びなので、出来れば横のまま転記したいです。
（りんご） 2021/08/28(土) 12:27
'----- シート 品目 集計 年月 個数 年月選択 A りんご 集計1 2103 5 2103 A りんご 集計1 2104 3 2104 A りんご 集計1 2105 7 2105 （中略） B すいか 集計2 2110 3 2110 B すいか 集計2 2111 1 2111 B すいか 集計2 2112 1 2112 '-----
これで、ピボットが使えます。
最初の１回は手間がかかりますが
次からは、「更新」を実行するだけです。
'-----
let
ソース = Excel.Workbook(File.Contents("D:\○○○\△△\転記元.xlsx"), null, true),
削除された他の列 = Table.SelectColumns(ソース,{"Name", "Data"}),
#"展開された Data" = Table.ExpandTableColumn(削除された他の列, "Data", Table.ColumnNames(削除された他の列[Data]{0})),
追加された条件列 = Table.AddColumn(#"展開された Data", "カスタム", each if Text.StartsWith([Column1], "集計") then "シート" else [Name]),
追加された条件列1 = Table.AddColumn(追加された条件列, "カスタム.1", each if Text.StartsWith([Column1], "集計") then "品目" else [Column1]),
追加された条件列2 = Table.AddColumn(追加された条件列1, "カスタム.2", each if Text.StartsWith([Column1], "集計") then [Column1] else null),
下方向へコピー済み = Table.FillDown(追加された条件列2,{"カスタム.2"}),
追加された条件列3 = Table.AddColumn(下方向へコピー済み, "カスタム.3", each if [カスタム.1] = "品目" then "集計" else [カスタム.2]),
削除された列 = Table.RemoveColumns(追加された条件列3,{"Name", "Column1", "カスタム.2"}),
昇格されたヘッダー数 = Table.PromoteHeaders(削除された列, [PromoteAllScalars=true]),
フィルターされた行 = Table.SelectRows(昇格されたヘッダー数, each [シート] <> "シート"),
ピボット解除された他の列 = Table.UnpivotOtherColumns(フィルターされた行, {"シート", "品目", "集計"}, "属性", "値"),
#"名前が変更された列 " = Table.RenameColumns(ピボット解除された他の列,{{"属性", "年月"}, {"値", "個数"}}),
重複された列 = Table.DuplicateColumn(#"名前が変更された列 ", "年月", "年月 - コピー"),
#"名前が変更された列 1" = Table.RenameColumns(重複された列,{{"年月 - コピー", "年月選択"}})
in
#"名前が変更された列 1"
（マナ） 2021/08/28(土) 15:01
（りんご） 2021/08/28(土) 16:53
色々考えてみたのですが、
果物名と数を変数に格納する
A〜Dの名前と数を変数に格納する
日付は転記元のB1:K1をfindとsearchで転記先のB1(始点)と一致する月の列を取得、変数に格納
ループで転記元にまずりんごのシートに転記していく
もし転記先のA列がりんごなら、
もし転記元のシートがAなら、変数に格納した転記元の列から表の1番右列までコピー
転記先に貼り付け…
次にBのシートから、次にCのシートから…
りんごが上記で埋まったら次に、みかん、すいか…と繰り返す。
こんな感じで出来ないか…と考えていますが、
コードにしようとすると色々調べたのをつなぎ合わせようとすると混乱してしまい上手くいきません。
もし難しいようでしたら、何か構想やヒントだけでも教えて頂けると幸いです。
宜しくお願い致します。
（りんご） 2021/08/28(土) 19:18
（マナ） 2021/08/28(土) 19:24
１）転記先の縦方向の位置を,dicSHに登録 dicSH(A)＝1、dicSH(B)＝2 ２）転記先の横方向の位置を,dicYMに登録 dicYM(2108）＝1、dicYM(2109）＝2 ３）転記元のデータをdicに登録（入れ子にします） dic(りんご)(集計1)(dicSH(A))(dicYM(2108))＝4 dic(りんご)(集計1)(dicSH(A))(dicYM(2109))＝1 ４）３）のデータのうち、dic(りんご)(集計1)データを、配列にセット ５）４）をりんごシートに転記 ６）３）のデータのうち、dic(りんご)(集計2)データを、配列にセット ７）６）をりんごシートに転記 ８）繰り返し
最初に、果物の種類数ｘ２の配列を用意しておいてもよいかもしれません。
（マナ） 2021/08/28(土) 20:15
キーを りんご・みかん＞集計１・２＞A・B＞日付 にして、Dictionaryで集計。 転記先で同じキーを作って取り出したらどうですか？
Sub Sample()
Dim RW As Long, CL As Long
Dim dicT As Object
Dim Ky
Dim AryRet
Dim WsTgt As Worksheet, WsSrc As Worksheet
Dim Title As Range
Dim WsName
Dim TTLkbn
Set dicT = CreateObject("Scripting.Dictionary")
For Each WsSrc In Workbooks("転記元.xlsx").Worksheets
With WsSrc
Set Title = Intersect(.Rows(1), .Range("A1").CurrentRegion)
TTLkbn = .Cells(1)
WsName = WsSrc.Name
For RW = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Cells(RW, 1) Like "集計*" Then
TTLkbn = .Cells(RW, 1)
RW = RW + 1
End If
For CL = 2 To .Range("A1").CurrentRegion.Columns.Count
If .Cells(RW, CL) <> "" Then
Ky = .Cells(RW, 1) & TTLkbn & "," & WsName & Title.Cells(1, CL)
dicT(Ky) = dicT(Ky) + .Cells(RW, CL).Value
End If
Next CL
Next RW
End With
Next WsSrc
For Each WsTgt In ThisWorkbook.Worksheets
With WsTgt
Set Title = Intersect(.Rows(1), .Range("A1").CurrentRegion)
TTLkbn = .Cells(1)
WsName = WsTgt.Name
.Range("A1").CurrentRegion.Offset(1, 1).ClearContents
AryRet = .Range("A1").CurrentRegion.Value
For RW = 2 To .Range("A1").CurrentRegion.Rows.Count
If .Cells(RW, 1) Like "集計*" Then
TTLkbn = .Cells(RW, 1)
RW = RW + 1
End If
For CL = 2 To .Range("A1").CurrentRegion.Columns.Count
Ky = WsName & TTLkbn & "," & .Cells(RW, 1) & Title.Cells(1, CL)
AryRet(RW, CL) = dicT(Ky)
Next CL
Next RW
'結果出力
.Range("A1").CurrentRegion = AryRet
Erase AryRet
End With
Next WsTgt
dicT.RemoveAll
End Sub
（半平太） 2021/08/28(土) 20:38
はい、そうです。ですが…
やはり、転記用配列を必要数用意するほうがよいですね。
それを配列にしておいて
dicには、配列のインデックスを登録します。
dic(りんご)(集計1)＝1
dic(りんご)(集計2)＝2
配列(1)が、りんご、集計1用の配列ということです。
配列(2)が、りんご、集計2用の配列ということです。
なので、
配列(dic(りんご)(集計1))(dicSH(A),dicYM(2108))=4
のように配列に登録していけます。（多分）
（マナ） 2021/08/28(土) 21:07
（マナ） 2021/08/28(土) 21:16
マナ様
色々ご丁寧に教えて下さり、ありがとうございます。
配列を複数分用意する事が必要な事も、マナ様のご説明で理解しました。
VBAではアウトプットは同じでも様々なアプローチ方法がある事を理解しました。
今後、教えて頂いた事を無駄にしないよう、習得していきたいと思います。
お忙しい中、本当にありがとうございました！
（りんご） 2021/08/28(土) 21:48
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.