VBAでシートをループする方法について

VBAの処理でブック内の「シートを順番にループ」していく方法をご紹介します。

（図１１１）やりたい事のイメージ

少し長いですが、シートをループするための構文は以下の通りです（後ろで説明を記載しています）。

（構文）

    '#1.各シートをループ
    For i1 = 1 To [シート総数]
	
        '#1-1.ループ対象のシートに該当するか？のチェック
        If ThisWorkbook.Worksheets(i1).Name = "QA分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "品質分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "商品開発チーム" Then

            '# 対象シートを変数wTmpにセット
            Dim wTmp As Worksheet: Set wTmp = ThisWorkbook.Worksheets(i1)

            '#1-1-1.各シートに対する処理
				
            '#### ココに処理を記述 ####
            '#### ココに処理を記述 ####
            '#### ココに処理を記述 ####
                
        End If
    Next i1

（図１１２）

 

上記の構文について、順を追って説明します。

一番外のforループについて、構文では省略していますが、まずはシートの総数を取得して、その数だけforループしています。

 

    '#1.各シートをループ
    For i1 = 1 To [シート総数]

        '### ループの中身 ###

    Next i1

 

次にif文でループしたい対象のシートか？を判定しています。ここは本来、対象シートを別で一覧保持して、それを読み込むべきですが、今回は簡単のため対象を直書きしてしまっています。また、対象に該当する場合は「wTmp」変数に値をセットしています。

 

    '#1.各シートをループ
    For i1 = 1 To [シート総数]

        '#1-1.ループ対象のシートに該当するか？のチェック
        If ThisWorkbook.Worksheets(i1).Name = "QA分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "品質分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "商品開発チーム" Then

            '# 対象シートを変数wTmpにセット
            Dim wTmp As Worksheet: Set wTmp = ThisWorkbook.Worksheets(i1)
            
            '### ループの中身 ###
            
        End If
    Next i1

＞目次にもどる

実際に動作するサンプルプログラムをご紹介します。以下にブックを添付しているので、初めての方は実際に動かしてみて頂けたらと思います。

（ブック）
⇒VBAシートループ_サンプル

 

（サンプル）

Sub LoopMultipleSheets()
    '#0-1.シートループの準備
    Dim WS_Count As Integer     'ブック中の総シート数を保持する変数
    Dim i1 As Integer           'シートループ用の変数
    
    ' WS_Countにブックの総シート数をセット
    WS_Count = ThisWorkbook.Worksheets.Count
    
    '#0-2.集約先のシート準備
    Dim wMerge As Worksheet: Set wMerge = ThisWorkbook.Worksheets("集約シート")
    ' 集約先シートの明細開始行
    Dim counter As Integer: counter = 6
    
    '#0-3.集約先シートの古い値をクリア
    Dim i0 As Integer           'ループ用の変数
    For i0 = 6 To 1000
        '# 最終行を検知したらループを抜ける
        If wMerge.Cells(i0, 3).Value = "E" Then
            Exit For
        End If
        '# 各行毎に値クリア
        Dim row As String: row = "C" & i0 & ":N" & i0
        wMerge.Range(row).ClearContents
    Next
    
    '#1.各シートをループ
    For i1 = 1 To WS_Count
        '# デバッグ用
        'Debug.Print ThisWorkbook.Worksheets(i1).Name
        '#1-1.ループ対象のシートに該当するか？のチェック
        If ThisWorkbook.Worksheets(i1).Name = "QA分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "品質分析チーム" Or _
            ThisWorkbook.Worksheets(i1).Name = "商品開発チーム" Then
            '# デバッグ用
            'Debug.Print ThisWorkbook.Worksheets(i1).Name
            '# 対象のシートを変数にセット
            Dim wTmp As Worksheet: Set wTmp = ThisWorkbook.Worksheets(i1)
            '#1-1-1.対象シートの行をループ
            For j1 = 6 To 1000
                '# 最終行を検知したらループを抜ける
                If wTmp.Cells(j1, 3).Value = "E" Then
                    Exit For
                End If
                
                '#1-1-1-1.各値を転記
                ' Category1～3の転記
                wMerge.Cells(counter, 1).Value = wTmp.Cells(j1, 1).Value
                wMerge.Cells(counter, 2).Value = wTmp.Cells(j1, 2).Value
                wMerge.Cells(counter, 3).Value = wTmp.Cells(j1, 3).Value
                wMerge.Cells(counter, 4).Value = wTmp.Cells(j1, 4).Value
                wMerge.Cells(counter, 5).Value = wTmp.Cells(j1, 5).Value
                wMerge.Cells(counter, 6).Value = wTmp.Cells(j1, 6).Value
                ' 担当者
                wMerge.Cells(counter, 9).Value = wTmp.Cells(j1, 9).Value
                ' 開始予定、終了予定、開始実績、終了実績
                wMerge.Cells(counter, 10).Value = wTmp.Cells(j1, 10).Value
                wMerge.Cells(counter, 11).Value = wTmp.Cells(j1, 11).Value
                wMerge.Cells(counter, 12).Value = wTmp.Cells(j1, 12).Value
                wMerge.Cells(counter, 13).Value = wTmp.Cells(j1, 13).Value
                counter = counter + 1
                
            Next j1
        End If
    Next i1
End Sub

＞目次にもどる