エクセルファイルのデータ転記について

画像の下のエクセルファイル(CSVと記載がありますがエクセルです）のデータを上の転記ファイルに転記させるマクロを作りました。赤の矢印のところに転記させるようにしています。
転記ファイルの黄色部の図番、品名、内製価格のデータは下のエクセルファイルにはありません。
この3つは現在、前回のデータをコピペしています。
例えば上の転記ファイルは下のエクセルファイルのデータを転記させた状態で、この時点では黄色部の部分は空白の状態です。
転記ファイルのC列のオ－ダ－NO. AA0000　D列のB00　E列の080　F列の枝番04-00
画像にはありませんが、もっと上のほうに枝番03-00という1個前のデータがあるので、03-00の時のデータをコピーして貼り付けをしています。この作業がなかなか大変なのでこちらも前のデータのものを拾って転記できないかと考えています。
考えているのが、AA0000　B00　080という番号を図番のAA0000B000801Bとマッチさせて転記できないかと。
画像のファイルだと次にAA0000　B00　080がきた場合枝番は06-00となりますが、図番、品名、内製価格の3つは前回の枝番のものと同じにしたいのです。
ややこしいのですが、枝番は数字だけではなくアルファベットの時もあります。AD-00など。その場合前回の枝番はAC-00。このように下へとどんどんデータが追加されていきます。
どういうやり方がよいのかは分かりませんが、自分で考えてみたコードだとうまくいきません。コードを貼り付けるので、いい方法があれば教えて頂きたいです。
図番、品名、内製価格のところのコードです。
分かりやすいように少し間隔を開けています。
ちなみに図番、品名、内製価格以外の転記はできています。

Sub 転記()
Dim wb As Workbook
Dim sh As Worksheet
Dim fname As String
Dim tbl As Variant
Dim r1 As Long, r2 As Long
Dim i As Long
Application.ScreenUpdating = False
Set sh = ActiveSheet
With sh
r1 = .Cells(Rows.Count, 2).End(xlUp).Row
tbl = .Range("C3:K" & r1)
End With
fname = ThisWorkbook.Path & "\" & "注文.xlsx"
Set wb = Workbooks.Open(fname)
With wb.Worksheets(1)

For r2 = 27 To .Cells(Rows.Count, 1).End(xlUp).Row
r1 = r1 + 1
sh.Cells(r1, 2).Value = .Cells(r2, 8).Value '注番転記
sh.Cells(r1, 3).Value = .Cells(r2, 9).Value 'オ－ダ－NO.転記
sh.Cells(r1, 4).Value = .Cells(r2, 10).Value '部門転記
sh.Range(sh.Cells(r1, 5), sh.Cells(r1, 6)).NumberFormatLocal = "@"
sh.Cells(r1, 5).Value = Format(.Cells(r2, 11).Value, "000") '製番転記
sh.Cells(r1, 6).Value = Format(.Cells(r2, 12).Value, "00") & "-" & Format(.Cells(r2, 13).Value, "00") '枝番転記
sh.Cells(r1, 9).Value = .Cells(r2, 17).Value '数量転記
sh.Range(sh.Cells(r1, 10), sh.Cells(r1, 11)).NumberFormatLocal = "#,##0"
sh.Cells(r1, 10).Value = .Cells(r2, 16).Value '単価転記
sh.Cells(r1, 17).Value = .Cells(r2, 7).Value '発注日転記
sh.Cells(r1, 18).Value = .Cells(r2, 20).Value '納期転記



'図番,品名,内製価格
For i = 1 To UBound(tbl)
If .Cells(r2, 9).Value = tbl(i, 1) And .Cells(r2, 10).Value = tbl(i, 2) _
And .Cells(r2, 11).Value = tbl(i, 3) Then
sh.Cells(r1, 7).Value = tbl(i, 5)
sh.Cells(r1, 8).Value = tbl(i, 6)
sh.Cells(r1, 11).Value = tbl(i, 9)
Exit For
End If
Next i






'メーカー
Select Case .Cells(r2, 5).Value
Case "CHUAN YAO MACHINERY CO.,LTD"
sh.Cells(r1, 16).Value = "全曜機械"
Case "ZEN MACHINERY CO.,LTD"
sh.Cells(r1, 16).Value = "大成ハイテック"
Case "MANUFACTURING(THAILAND)"
sh.Cells(r1, 16).Value = "HMT"
End Select
Next r2
End With
With sh
End With

Range("A1:A2000").EntireRow.Delete
wb.Save
wb.Close

'wb.Close
'Kill fname
Application.ScreenUpdating = True
End Sub

どなたか知恵えを貸して下さい。
よろしくお願いします。

No.2 ベストアンサー 回答者： tatsumaru77 回答日時： 2024/02/17 21:58

＞マクロを実行すると0のものを拾っていますので、必ず１個前に記入したものを拾うようにして頂きたいです。

１個前は必ずBになっています。

「既存のオーダー、部門、製番が一致する行で、最も下の行が取得対象となる」と理解しました。
現在、上から下へ検索をしていますが、これを下から上に検索するようにすれば良いです。
以下のようになります。

'図番,品名,内製価格
For i = UBound(tbl) To 1 Step -1
If .Cells(r2, 9).Value = tbl(i, 1) And .Cells(r2, 10).Value = tbl(i, 2) _
And .Cells(r2, 11).Value = CLng(tbl(i, 3)) Then
sh.Cells(r1, 7).Value = tbl(i, 5)
sh.Cells(r1, 8).Value = tbl(i, 6)
sh.Cells(r1, 11).Value = tbl(i, 9)
Exit For
End If
Next i

この回答へのお礼

ありがとうございました。
助かりました。

お礼日時：2024/02/18 08:03

No.1 回答者： tatsumaru77 回答日時： 2024/02/17 11:26

If .Cells(r2, 9).Value = tbl(i, 1) And .Cells(r2, 10).Value = tbl(i, 2) _

And .Cells(r2, 11).Value = tbl(i, 3) Then

の箇所ですが、下の行を
And .Cells(r2, 11).Value = CLng(tbl(i, 3)) Then
に変えてください。
比較の時、左辺が数値で右辺が文字になっています。
（35と"035"を比較しているイメージです。）
右辺を一旦、数値に変換してから比較します。
（製番は必ず数字である前提で書いてます）

この回答へのお礼

回答ありがとうございます。
図番についてですが、説明不足で申し訳ないのですが、例えば3行目のAA0000B000801Bは最後のBが図番変更の回数となっています。
なので、1個前はA、その前は0になります。
マクロを実行すると0のものを拾っていますので、必ず１個前に記入したものを拾うようにして頂きたいです。１個前は必ずBになっています。
それと内製価格は転記されるものとされないものがあります。
考えられる理由として、1個前に記入されているものにコメントがあるのと、数字の色が赤になっている場合です。
１個前にコメントがないものと数字の色が赤になっていないものは転記されていますので、おそらくこれが原因ではないかと思います。
転記した場合にコメントや数字を赤くする必要はありません。
その時の図番によって、内製価格も違う場合があるので、必ず１個前の価格を拾うようにして頂きたいです。
品名は完璧です。
よろしくお願いします。

お礼日時：2024/02/17 21:21