Excel VBA 転記について

ExcelのVBAを使用した転記についてご教授お願い致します。
初心者のもので簡単な解説があると助かります。

スケジュール管理をするうえで
業務依頼があるとExcelファイル(設計1課ファイル、設計2課ファイルの2つ)に記入されます。
※課が異なるので2つのファイルに分かれています。

業務依頼で記入したExcelファイルから必要項目のみを
スケジュール管理しているExcelファイル(1つ)に転記したいです。
ただし、業務依頼のファイルには、日々業務依頼があると
新しく最終行に追加されていきます。
また、業務依頼のファイルは、スケジュール管理のファイルと
違うフォルダに入っています。

転記したいセル (転記したい項目)
■転記元ファイル □転記先ファイル
B9 (見積番号) → G6 (注文仕様書番号)
C9 (見積日) → B6 (見積日)
F9 (担当者) → J6 (担当者)
G9 (納期) → M6 (納期)
M9 (注文依頼書名) → I6 (注文仕様書名)

画像データは、上側が転記元のファイルで
下側が転記先ファイルになります。

出来たら、見積番号より転記していない番号を検索し
スケジュール管理するExcelの最終行に転記する事は、
可能でしょうか?

よろしくお願いいたします。

No.1 ベストアンサー 回答者： fujillin 回答日時： 2022/04/20 23:17

こんばんは

回答がないようですので・・・

内容的には単純な転記ですが、表の形式がバラバラなのがわかりにくくしていますね。
・ファイル名やシート名、パス等の不明部分に関しては適当になっています。
・必要なファイルは既に開いているものとし、直接指定してあります。
　（ファイルを開く処理から必要なら、追加してください）
・シート内で「見積番号」に重複は存在しないものと仮定しています。

以下、ご参考までに。

Sub Q12909476()
Dim Dic As Object, v As Variant
Dim sh As Worksheet
Dim rw As Long, n As Long, i As Long
Set Dic = CreateObject("Scripting.Dictionary")

Set sh = Workbooks("hoge").Worksheets("Sheet1") '←転記元ファイルの該当シート
With Workbooks("fuga").Worksheets("Sheet1") '←転記先ファイルの該当シート

n = .Cells(Rows.Count, 7).End(xlUp).Row
rw = Application.Max(n, 5) + 1
v = Cells(1, 7).Resize(Application.Max(n, 2)).Value
For i = 6 To UBound(v)
If v(i, 1) <> "" Then Dic.Add v(i, 1), 1
Next i

n = sh.Cells(Rows.Count, 2).End(xlUp).Row
v = sh.Cells(1, 2).Resize(Application.Max(n, 2)).Value
For i = 9 To UBound(v)
If Not Dic.exists(v(i, 1)) And v(i, 1) <> "" Then
.Cells(rw, 7).Value = v(i, 1)
.Cells(rw, 2).Value = sh.Cells(i, 3).Value
.Cells(rw, 10).Value = sh.Cells(i, 6).Value
.Cells(rw, 13).Value = sh.Cells(i, 7).Value
.Cells(rw, 9).Value = sh.Cells(i, 13).Value
Dic.Add v(i, 1), 1
rw = rw + 1
End If
Next i

End With
End Sub

この回答へのお礼

お忙しい中、ご教示いただきありがとうございました。
早速、作業してみたいと思います。

お礼日時：2022/04/21 13:25