『データの転記』（社会人）
データの転記について教えていただきたいです。
Book1には
A| B| C| D| E|
日付｜生産地｜生産者 |品種 ｜キロ数｜入荷数｜
1 |1/1 |〇〇県 |〇〇農家| 〇〇 | 10kg | 100cs|
2 |1/3 |××県 |××農家| ×× | 20kg | 150cs|
3 |1/4 |△△県 |△△農家| △△ | 10kg | 100cs|
・
・
・
・
のような入荷予定が入っています。
Book2には
A| B| C| D| E| F| G| H| | K|
1/1| 1/2| 1/3| 1/4|・・| 1/7|
〇〇県(生産地)|〇〇(品種)｜〇〇農家|10kg｜ | | | | | |
××県(生産地)|××(品種)｜××農家|20kg｜ | | | | | |
△△県(生産地)|△△(品種)｜△△農家|10kg｜ | | | | | |
のような表があります。
これを
A| B| C| D| E| F| G| H| | K|
1/1| 1/2| 1/3| 1/4|・・| 1/7|
〇〇県(生産地)|〇〇(品種)｜〇〇農家|10kg｜ 100| | | | | |
××県(生産地)|××(品種)｜××農家|20kg｜ | | 150| | | |
△△県(生産地)|△△(品種)｜△△農家|10kg｜ | | | 100| | |
というように転記するマクロを教えていただきたいです。
＜ 使用 Excel：Excel2021、使用 OS：Windows11 ＞
Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow1 As Long, lastRow2 As Long, lastCol2 As Long
Dim i As Long, j As Long
Dim dateCol As Range, foundDate As Range
' ワークシートを設定
Set ws1 = Workbooks("Book1.xlsx").Worksheets(1) ' Book1
Set ws2 = Workbooks("Book2.xlsx").Worksheets(1) ' Book2
' 最終行と列を取得
lastRow1 = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row ' Book1の最終行
lastRow2 = ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row ' Book2の最終行
lastCol2 = ws2.Cells(3, ws2.Columns.Count).End(xlToLeft).Column ' Book2の最終列（3行目に日付）
' Book1のデータをループ
For i = 2 To lastRow1 ' 1行目はヘッダーなので2行目から開始
Dim dateValue As Variant, location As String, producer As String, variety As String, weight As String, arrivalQty As Variant
dateValue = ws1.Cells(i, 1).Value ' 日付
location = ws1.Cells(i, 2).Value ' 生産地
producer = ws1.Cells(i, 3).Value ' 生産者
variety = ws1.Cells(i, 4).Value ' 品種
weight = ws1.Cells(i, 5).Value ' キロ数
arrivalQty = ws1.Cells(i, 6).Value ' 入荷数
' Book2で一致する行を検索
For j = 4 To lastRow2 ' データは4行目以降に存在する
If ws2.Cells(j, 1).Value = location And _
ws2.Cells(j, 2).Value = variety And _
ws2.Cells(j, 3).Value = producer And _
ws2.Cells(j, 4).Value = weight Then
' 日付に一致する列を検索
Set dateCol = ws2.Rows(3) ' 日付が記載されている3行目
Set foundDate = dateCol.Find(What:=dateValue, LookIn:=xlValues, LookAt:=xlWhole)
If Not foundDate Is Nothing Then
' 入荷数を転記
ws2.Cells(j, foundDate.Column).Value = arrivalQty
End If
Exit For ' 次のデータへ進む
End If
Next j
Next i
MsgBox "データ転記が完了しました！", vbInformation
End Sub
日付、生産地、生産者、品種、キロ数、入荷数を取得します。
Book2で一致する行と列を検索:
生産地、品種、生産者、キロ数が一致する行を探し、さらに日付が一致する列を特定します。
データを転記:
該当するセルに入荷数を転記します。
完了通知:
転記が完了するとメッセージボックスで通知します。
実行する際の注意点
Book1.xlsxとBook2.xlsxのファイル名を適宜変更してください。
ファイルは必ず開いた状態でマクロを実行してください。
日付やデータ形式が正しく一致していることを確認してください。
（通りすがり） 2025/03/16(日) 13:14:44
ありがとうございます。
頂いたものが例で動くことを確認しました。
報告には少しお時間いただきますが、現在使用しているものに合わせ内容をかえて試してみようと思います。
また詰まったら改めて相談させてください。
（社会人） 2025/03/16(日) 14:53:13
Book1
G列に作業列を追加して G2 =B2&"\"&D2&"\"&C2 下コピー
|[A] |[B] |[C] |[D] |[E] |[F] |[G]
[1]|日付|生産地 |生産者 |品種 |キロ数 |入荷数 |作業列
[2]|1/1 |〇〇県 |〇〇農家| 〇〇 | 10kg | 100cs|〇〇県 \ 〇〇 \〇〇農家
[3]|1/3 |××県 |××農家| ×× | 20kg | 150cs|××県 \ ×× \××農家
[4]|1/4 |△△県 |△△農家| △△ | 10kg | 100cs|△△県 \ △△ \△△農家
Book2
E列に作業列を追加して
E2 =LEFT(A2, FIND("(", A2)-1)&"\"&LEFT(B2, FIND("(", B2)-1)&"\"&C2 下コピー
F2 =FILTER([Book1]Sheet1!$F$2:$F$4,([Book1]Sheet1!$A$2:$A$4=F$1)*([Book1]Sheet1!$G$2:$G$4=$E2),"") 右下コピー
|[A] |[B] |[C] |[D] |[E] |[F] |[G]|[H] |[I] |[J]|[K]|[L]
[1]| | | | |作業列 |1/1 |1/2|1/3 |1/4 |1/5|1/6|1/7
[2]|〇〇県 (生産地)| 〇〇 (品種)|〇〇農家| 10kg |〇〇県 \ 〇〇 \〇〇農家| 100cs| | | | | |
[3]|××県 (生産地)| ×× (品種)|××農家| 20kg |××県 \ ×× \××農家| | | 150cs| | | |
[4]|△△県 (生産地)| △△ (品種)|△△農家| 10kg |△△県 \ △△ \△△農家| | | | 100cs| | |
（ななし） 2025/03/16(日) 15:25:21
ありがとうございます。
実は元のデータが結構めんどくさくて(-_-;)
今回はマクロの方が楽になるかなと思います。
同じファイルをずっと更新しながら使い続けているのです。
入荷予定(Book1)自体は外部から入ってくるのですが、
シート1
1/1
1/2
・
・
・
1/7
次の週には
シート2に
1/1
1/2
・
・
1/14
みたいな感じで最終的にはシート4くらいに1/1〜1/31まで全部そろうみたいな。
Book2自体も毎週下に追加されていく形になるのですが、
毎週その前の表をコピーして下に貼り付け、入荷に合わせて在庫に合わせて一部をクリアして〜みたいなことがありまして
最新の日付のシートを探したり、コピーして日付を変えるみたいなマクロは書けたのですが、肝心の転記部分がうまくいかず今回相談させていただきました。
今回は通りすがり様から頂いたものを活用させていただこうと思いますが、
頂いた数式はとても勉強になります。
ありがとうございます。
落とし込むまでちょっと時間がかかるかもしれませんが結果報告ができるように頑張ります。
（社会人） 2025/03/16(日) 15:48:58
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.