目次

目的

複数あるワークシートに対してループ処理を行いたい。

ループの中で各ワークシートのセルの値を取得したい。

ループの中で各ワークシートのセルの値を設定・変更したい。

目次まで戻る

題材

以下の Excel ワークシートをループします。 3 シートあります。

  • Sheet1
  • Sheet2
  • Sheet3

各ワークシートには、別々の文字が入力されています。

Sheet1:

ダミー文字とダミー数字が入力されている表です。

Sheet2:

Sheet3:

下のほうに書いあります「取得方法」では、新規ワークシートを先頭に挿入後、各ワークシートの表を集計するマクロを書いてあります。

下のほうに書いあります「設定方法」では、各ワークシートの表の末尾に新しいデータを入力するマクロを書いてあります。

目次まで戻る

取得方法

Excel VBA のコード:

Sub セル値取得_002330()

    'ワークシートの存在有無チェック

        Dim c As Boolean 'check の略です。値は true か false が入るブール型です。ワークシートの存在有無チェックに使用します。
        c = False '初期値は false なので必要ないかもしれません。
        
        Dim n As Integer 'number の略です。ワークシートを左から数えて何番目の番号です。
        
        For n = 1 To Worksheets.Count '全ワークシートを左から順にループしています。
            Debug.Print n; Worksheets(n).Name 'イミディエイトウィンドウにワークシートの番号と名前を出力しています。
            
            If Worksheets(n).Name = "集計" Then 'ワークシート名が「集計」とイコールになるかを判定しています。
                c = True '「集計」という名前のシートが存在する場合は変数 c に true を代入します。
            End If
        
        Next

    'ワークシート新規作成
        
        Dim w As Worksheet 'worksheet の略です。
        
        If Not c Then 'c が true ではない場合の処理です。'「集計」シートが存在していない場合です。
            Set w = ActiveWorkbook.Sheets.Add(Before:=Worksheets(1)) '先頭のワークシートの直前に新規ワークシートを挿入しています。
            w.Name = "集計" '新規ワークシートの名前を「集計」に変更しています。
        Else
            Set w = Worksheets("集計") '「集計」シートが存在している場合です。
        End If
        
    '「Sheet1」シートの見出し部分を「集計」シートにコピー
                
        Worksheets("Sheet1").Range("A1:B1").Copy Worksheets("集計").Range("A1") 'コピー元とコピー先を設定しています。
        
    'Shee1 ~ Shee3 のデータ部分を「集計」シートにコピー
        
        For n = 1 To Worksheets.Count '全ワークシートを左から順にループしています。
            
            If Not Worksheets(n).Name = "集計" Then '「集計」シート以外の場合の処理です。
                Dim r As Long 'row の略です。「集計」シートのデータ終端の行番号が入ります。
                r = Worksheets("集計").Range("A1").CurrentRegion.Rows.Count
                                
                Worksheets(n).Range("A2:B2").Copy Worksheets("集計").Cells(r + 1, 1) '「集計」シートのデータ終端の行+1 の行にデータをコピーしています。
            End If
        
        Next

End Sub

上記のコードを実行すると以下のような結果になりました。 Sheet1 ~ 3 のデータをコピーすることができました。

マクロの実行結果です。

目次まで戻る

設定方法

Excel VBA のコード:

Sub セル値設定_002330()

    'Shee1 ~ Shee3 のデータ部分に新しいデータを追加
        
        For n = 1 To Worksheets.Count '全ワークシートを左から順にループしています。
            
            If Not Worksheets(n).Name = "集計" Then '「集計」シート以外の場合の処理です。
                Dim r As Long 'row の略です。各シートのデータ終端の行番号が入ります。
                r = Worksheets(n).Range("A1").CurrentRegion.Rows.Count
                                
                Worksheets(n).Range("A" & r + 1 & ":B" & r + 1).Value = Array("新規文字", "新規数字") '各シートのデータ終端の行+1 の行に新規データを入力しています。 Array 関数を使用しています。
            
                '以下の様にしても良いと思います。
                'Worksheets(n).Range("A" & r + 1).Value = "新規文字"
                'Worksheets(n).Range("B" & r + 1).Value = "新規数字"
            
            End If
        
        Next

End Sub

上記のマクロを実行すると以下のようになりました。各ワークシートの末尾に新しいデータが入力されました。

Sheet1:

Sheet2:

Sheet3:

目次まで戻る

テスト環境

  • Windows 10
  • Microsoft Office Excel 2003

間違ってないと良いですが。

以上、閲覧ありがとうございました。

目次まで戻る

この投稿のタグ

同じカテゴリの投稿( Excel VBA )

前後の投稿