[[20220921091242]]　『複数のシートの値を転記したい』（黒ネコ）　ページの最後に飛ぶ

『複数のシートの値を転記したい』（黒ネコ）

左から4番目以降の複数ある条件に合ったシートの値を一覧シートへ転記したいのですが、現在　Sheets("100001")しか転記できません。4番目以降のシートを全て転記するにはどのように変更すればよいか教えてください。
　
　Dim a_Sht As Worksheet
　Dim b_Sht As Worksheet
　Dim MyList() As Variant
　Dim LastRow As Long
　Dim i As Long
　Dim j As Long

    Set a_Sht = Sheets("一覧")
    Set b_Sht = Sheets("100001")
    'シート A列～D列のデータを配列に格納
    b_Sht.Select
    MyList = b_Sht.Range("A2", Range("A" & Rows.Count). _
                     End(xlUp)).Resize(, 4).Value
    '最終行
    LastRow = a_Sht.Cells(Rows.Count, 1).End(xlUp).Row
    'シート ループ
    For i = 1 To LastRow
    For j = 1 To UBound(MyList)
            '複数条件一致で別シート転記
            If a_Sht.Cells(i, 1) = MyList(j, 1) And _
                    a_Sht.Cells(i, 5) = MyList(j, 2) Then
                a_Sht.Cells(i, 6) = MyList(j, 3)
                a_Sht.Cells(i, 7) = MyList(j, 4)
            End If
        Next j
    Next

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

ご参考。

https://www.google.com/search?q=vba+%E8%A4%87%E6%95%B0%E3%82%B7%E3%83%BC%E3%83%88+%E3%83%AB%E3%83%BC%E3%83%97

（ひまじん） 2022/09/21(水) 09:21

    Dim a_Sht As Worksheet
    Dim b_Sht As Worksheet
    Dim MyList() As Variant
    Dim LastRow As Long
    Dim idx As Long
    Dim i As Long
    Dim j As Long

    Set a_Sht = Sheets("一覧")
    '最終行
    LastRow = a_Sht.Cells(Rows.Count, 1).End(xlUp).Row

    For idx = 4 To Worksheets.Count
        Set b_Sht = Worksheets(idx)
        'b_Sht.Select
        'シート A列～D列のデータを配列に格納
        MyList = b_Sht.Range("A2", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
        'シート ループ
        For i = 1 To LastRow
            For j = 1 To UBound(MyList)
                '複数条件一致で別シート転記
                If a_Sht.Cells(i, 1) = MyList(j, 1) And _
                        a_Sht.Cells(i, 5) = MyList(j, 2) Then
                    a_Sht.Cells(i, 6) = MyList(j, 3)
                    a_Sht.Cells(i, 7) = MyList(j, 4)
                End If
            Next j
        Next i
    Next idx

一例です。
この例ではA列B列のデータが同じものが複数ある場合
後から出て来た方が前のデータを上書きします｡
（下手の横好き） 2022/09/21(水) 09:35

下記へ変更し結果は得られたのですがあってますでしょうか。ご指摘があれば教えてください。

Dim a_Sht As Worksheet
Dim b_Sht As Worksheet
Dim MyList() As Variant
Dim LastRow As Long
Dim i As Long
Dim j As Long
Dim シートNo As Long

    For シートNo = 2 To Worksheets.Count

    Set a_Sht = Sheets("一覧")
    Set b_Sht = Worksheets(シートNo)
    'シート A列～D列のデータを配列に格納
    b_Sht.Select
    MyList = b_Sht.Range("A2", Range("A" & Rows.Count). _
                     End(xlUp)).Resize(, 4).Value
    '最終行
    LastRow = a_Sht.Cells(Rows.Count, 1).End(xlUp).Row
    'シート ループ
    For i = 1 To LastRow
    For j = 1 To UBound(MyList)
            '複数条件一致で別シート転記
            If a_Sht.Cells(i, 1) = MyList(j, 1) And _
                    a_Sht.Cells(i, 5) = MyList(j, 2) Then
                a_Sht.Cells(i, 6) = MyList(j, 3)
                a_Sht.Cells(i, 7) = MyList(j, 4)
            End If
        Next j
    Next
   Next

（黒ネコ） 2022/09/21(水) 09:56

 >結果は得られたのですが
 それでいいんじゃないですか。
（x7t） 2022/09/21(水) 10:21

既に直っているところもありますが、何点か。

■１
VBAの世界では基本的に、シートやセル（オブジェクトと言います）をきちんと明示すれば、いちいちアクティブにしたり選択したりする必要はありません、

■２
こだわりが無ければ、インデントの付け直しを検討してみてください。
適切なインデント付けを行うと、コード全体の構造が把握しやすくなりご自身のデバッグ作業の効率アップに寄与すると思います。

■３
Sub～End Subまでが１つのプロシージャと呼ばれるかたまりですから、提示される場合は極力、最初から最後まで提示されたほうがお互いに誤解が無くてよいとおもいます。

■４
↓について「一覧」シートは固定ならば、ループのなかで逐一セットする必要は薄いと思います。

 For シートNo = 2 To Worksheets.Count
     Set a_Sht = Sheets("一覧")
     Set b_Sht = Worksheets(シートNo)

■５
＞左から4番目以降の～
＞ For シートNo = 2 To Worksheets.Count
非表示シートがあるかもしれませんが、少なくとも【左から4番目以降】になってません。

■６
＞条件に合ったシートの値を一覧シートへ転記
２重ループで逐一調べずとも、オートフィルタなどで【抽出】してコピペではだめなのですか？

（もこな２） 2022/09/21(水) 13:39

反応ないですが追加で。
■７
「2022/09/21(水) 09:56」に提示されたコードを整理すると↓のようになるとおもいますが、

    Sub 整理()
        Dim シートNo As Long, i As Long, j As Long

        For シートNo = 2 To Worksheets.Count
                For i = 1 To Sheets("一覧").Cells(Rows.Count, 1).End(xlUp).Row
                    For j = 2 To Worksheets(シートNo).Cells(Rows.Count, "A").End(xlUp).Row
                        If Sheets("一覧").Cells(i, "A").Value = Worksheets(シートNo).Cells(j, "A").Value And _
                           Sheets("一覧").Cells(i, "E").Value = Worksheets(シートNo).Cells(j, "B").Value Then
                            Worksheets(シートNo).Cells(j, "C").Resize(, 2).Copy Sheets("一覧").Cells(i, "F")
                        End If
                    Next j
                Next i
        Next シートNo
    End Sub

↓のような関係性ですから、シートが切り替わるたびに「i」が1から始まるのですが想定通りなのですか？

 For シートNo = 2 To Worksheets.Count
     For i = 1 To Sheets("一覧").Cells(Rows.Count, 1).End(xlUp).Row

（もこな２） 2022/09/23(金) 10:04

コメント返信：

[ 一覧(最新更新順) ]

[[20220921091242]] 『複数のシートの値を転記したい』（黒ネコ） ページの最後に飛ぶ

[[20220921091242]]　『複数のシートの値を転記したい』（黒ネコ）　ページの最後に飛ぶ