[[20230305152245]]　『条件一致したら転記する際に、複数列まとめて転記』（マクロくん）　ページの最後に飛ぶ

『条件一致したら転記する際に、複数列まとめて転記するには』（マクロくん）

初めまして。
マクロ初心者で手探りで勉強中です。
要約の件、分かる方がいらっしゃいましたら教えてください。

＜単価表シート＞

 商品	産地	単価	メモ
 いちご	栃木	100	OK
 いちご	福岡	150	NG
 いちご	熊本	200	〇
 いちご	静岡	200	×
 メロン	茨城	100	OK
 メロン	熊本	200	▽
 メロン	青森	250	▲
 メロン	静岡	300

＜抽出シート＞

 商品	産地	単価	メモ
 メロン	静岡		
 いちご	福岡		
 メロン	青森		
 いちご	栃木		
 いちご	栃木

抽出シートの商品と産地が単価表シートと一致したら、
抽出シートの単価列とメモ列に単価表シートの内容を転記するマクロまではわかりました。
今回やりたいことは、メモ欄が例えばメモ1, メモ2…, メモ100まであったとした時、
下記マクロだとメモを転記するのに100列分コードを用意することになります。
ここを100個用意。
Chusyutu_Sht.Cells(i, 3) = MyList(j, 3)
Chusyutu_Sht.Cells(i, 4) = MyList(j, 4)

何か一度に複数列転記する方法はありますか？
Chusyutu_Sht.Cells(i, 3) = MyList(j, 3).Resize(,100)とするとエラーになってしまいます。

Dim Chusyutu_Sht As Worksheet
Dim Tanka_Sht As Worksheet
Dim MyList() As Variant
Dim LastRow As Long
Dim i As Long
Dim j As Long

    Set Chusyutu_Sht = Sheets("抽出")
    Set Tanka_Sht = Sheets("単価表")
    '「単価表」シート A列～D列のデータを配列に格納
    Tanka_Sht.Select
    MyList = Tanka_Sht.Range("A2", Range("A" & Rows.Count). _
                     End(xlUp)).Resize(, 4).Value
    LastRow = Chusyutu_Sht.Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To LastRow
        For j = 1 To UBound(MyList)
            '複数条件一致で別シート転記
            If Chusyutu_Sht.Cells(i, 1) = MyList(j, 1) And _
                    Chusyutu_Sht.Cells(i, 2) = MyList(j, 2) Then

                Chusyutu_Sht.Cells(i, 3) = MyList(j, 3)
                Chusyutu_Sht.Cells(i, 4) = MyList(j, 4)
            End If
        Next j
    Next
End Sub

よろしくお願いします。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

パワークエリをおすすめします。
（フォーキー） 2023/03/05(日) 17:02:41

フォーキー様
ありがとうございます。
パワークエリ、このような整理に適しているのですね。

今回はマクロで考えたいので、引き続き何か良い方法あればよろしくお願いします。
（マクロくん） 2023/03/05(日) 17:10:25

 もうひとつループしてみては。

    For k = 3 To UBound(MyList, 2)
        Chusyutu_Sht.Cells(i, k) = MyList(j, k)
    Next
（缶ピー） 2023/03/05(日) 17:44:12

まったく違うコードで申し訳ないですが。

 Sub test()
     Dim Chusyutu_Sht As Worksheet, Tanka_Sht As Worksheet
     Dim LastR As Long
     Set Chusyutu_Sht = Worksheets("抽出")
     Set Tanka_Sht = Worksheets("単価表")
     With Tanka_Sht
         .Range("E1") = "作業列"
         .Range("E2", .Cells(.Cells(Rows.Count, 1).End(xlUp).Row, "E")).Formula = "=A2&B2"
     End With
     With Chusyutu_Sht
         LastR = .Cells(Rows.Count, 1).End(xlUp).Row
         .Range("C2").Resize(LastR - 1).Formula = "=INDEX(単価表!C:C,MATCH($A2&$B2,単価表!$E:$E,0))"
         .Range("D2").Resize(LastR - 1).Formula = "=INDEX(単価表!D:D,MATCH($A2&$B2,単価表!$E:$E,0))"
         .Range("C2").Resize(LastR - 1, 2).Value = .Range("C2").Resize(LastR - 1, 2).Value
     End With
     Tanka_Sht.Range("E:E").Delete
 End Sub
（フォーキー） 2023/03/05(日) 17:53:52

缶ピー様
ありがとうございます。
実験してみているのですが、結果がすべて300になってしまったり、メモ欄が張り付かなかったりします。
具体的にどこに下記コードを組み込む感じでしょうか？

    For k = 3 To UBound(MyList, 2)
        Chusyutu_Sht.Cells(i, k) = MyList(j, k)
    Next

フォーキー様
ありがとうございます。
このようなやり方もあるのですね。
関数埋め込むと便利ですね。
範囲指定の方法もいろいろ参考になりました。
（くるみ） 2023/03/05(日) 18:44:29

 Chusyutu_Sht.Cells(i, 3) = MyList(j, 3)
 Chusyutu_Sht.Cells(i, 4) = MyList(j, 4)

 上記部分を置き換えです。
 メモ欄が張り付かないのは、配列の大きさを変更していないのでは？
 （.Resize(, 4)のまま。）
 コード全部を見直すつもりはありませんので、ご自身で対応お願いします。

 あと、ニックネーム直し忘れてますよ。
（缶ピー） 2023/03/05(日) 19:28:32

缶ピー様
ありがとうございます。
理解しました。
配列、便利ですね。勉強してみます。

別の質問で投稿させて頂いた時にニックネーム変えた方がいいかと思って変えたらそのままになっていました。
（そちらの方でも缶ピー様に回答頂いたようで、大変ありがとうございます。）
（マクロくん） 2023/03/05(日) 20:30:52

 >の質問で投稿させて頂いた時にニックネーム変えた方がいいかと思って

 いやぁーあの手この手と色々考えますね。
 今回はバレて残念。
（残念） 2023/03/05(日) 21:00:46

コメント返信：

[ 一覧(最新更新順) ]

[[20230305152245]] 『条件一致したら転記する際に、複数列まとめて転記』（マクロくん） ページの最後に飛ぶ

[[20230305152245]]　『条件一致したら転記する際に、複数列まとめて転記』（マクロくん）　ページの最後に飛ぶ