目次
目的
複数あるワークシートに対してループ処理を行いたい。
ループの中で各ワークシートのセルの値を取得したい。
ループの中で各ワークシートのセルの値を設定・変更したい。
題材
以下の 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
間違ってないと良いですが。
以上、閲覧ありがとうございました。