リモートワークなんかで、同じエクセルファイルを共有して作業することが増えてきたという人もいるかと思います。
例えば各シートにそれぞれの担当者がデータを入力したとします。
それをひとつのシートにまとめないといけない、といった場合、どうやってデータをまとめますか？
各シートのセルを参照してというのもひとつの手ですが、マクロの機能で組んでしまうととても楽ですよ。
本記事では『VBAで各シートのセルのデータを集めて表を自動作成する方法』について解説します。
こちらの記事も参考になると思いますので、併せてご覧くださいね。
この記事の内容
1．ゴールとステップ
こんにちは。エクセルマン・ブリーダーのしもむぎ(@re_znd13)です。
まずは本記事のゴールとそこまでのステップを示します。
1．1 ゴール
以下の画像のような表を、自動で作成するようなVBAコードを得ることをゴールとします。
国語、数学、英語、理科、社会という科目ごとのシートから氏名と点数をTOTALというシートに取得して、総合点でソートをかけ、罫線を付加して表を作成するのです。
前提として、国語、数学、英語、理科、社会のシートは、以下の画像のように、出席番号順の点数一覧となっていることとします。
名簿の順番が違えば作り方が変わってしまいますが、今回はそこが合っているという条件です。
1．2 ステップ
以下のステップで進めていこうと思います。
- 集計用のシートをリセットする
- 氏名を取得する
- 各科目の点数を取得する
- 総合点を算出する
- 総合点でソートをかける
- 罫線を付加する
こういった順で表を作成してみます。順に見ていきましょうね。
2．集計用のシートをリセットする
最初のステップです。
このリセットは、不要と思われる方もいるかもしれませんが、重要なステップと考えます。
一度内容をすべて消すことで、各シートのデータが変わってしまってもフレキシブルに表を自動作成することができます。
対象のシートのセルをすべてクリアしてリセットします。
VBAコードは以下です。
この一文で、もともとセル内にデータがあったり罫線があったりしてもクリアすることができます。
シートは名前で指定してもよいです。
以下のコードでは1番目のシートとしました。
これは集計用のシートの順番を変えないことが前提ですが、シート名を変えられてしまっても動作できるようにと考えたためです。
Sub リセット()
Sheets(1).Cells.Clear
End Sub3．氏名を取得する
第1章の画像で示したように、各科目のシートは氏名と点数の一覧となっています。
そこで、以下のようなVBAコードで、2番目のシート（ここでは国語）から取得してきます。
生徒数が増減してもよいように、A列全体をコピーし、1番目のシート（ここではTOTAL）のA列にペーストします。
画像は実行結果です。
Sub 氏名取得()
Sheets(2).Range("A:A").Copy Sheets(1).Range("A1")
End Sub
4．各科目の点数を取得する
次のステップでは各科目のシートから点数を取得します。
科目数が変わってもよいように組んでみましょう。
VBAコードは以下です。
kはワークシート数を取得しています。
今回は6という数値が取得されるはずです。
iは2番目からk番目までのシートの番号になります。
For～文でループを組みます。
どの科目でもB列に点数が入力されていますので、B列全体をコピー。
そして1番目の集計用のシートにペーストします。
ここではi列を選択することに注意しましょう。
画像が実行結果です。
Sub 点数取得()
Dim i, k As Long
k = Worksheets.Count
i = 2
For i = 2 To k
Sheets(i).Range("B:B").Copy Sheets(1).Cells(1, i)
Next
End Sub
5．総合点を算出する
各科目の点数が取得できたら、右端の列（ここではG列）に総合点を算出します。
VBAコードは以下です。
kは前章と同じくシート数ですね。
一番右端の列はk+1番目の列ですから、Cells(1,k+1)としてTOTALという文字列を入力しました。
生徒数が増減してもよいように、氏名が記入されているA列が空白になるまでループをさせましょう。
jという変数を置き、A列のj番目の行が空白になるまで、というループにはDo while文が便利です。
また総合点の算出には、Sum関数を用いました。
これはワークシートファンクションですので、記述に注意です。
Do while文では変数が自動で進みませんので、j=j+1を忘れずに。
画像は実行結果です。
Sub 総合点算出()
Dim j, k As Long
k = Worksheets.Count
Sheets(1).Cells(1, k + 1).Value = "TOTAL"
j = 2
Do While Cells(j, 1) <> ""
Sheets(1).Cells(j, k + 1).Value _
= WorksheetFunction.Sum(Range(Cells(j, 2), Cells(j, k)))
j = j + 1
Loop
End Sub
6．総合点でソートをかける
総合点を算出したら、ソートをかけてみましょう。
ソートをかける場合はSortメソッドを使います。
構文は以下です。
Sort(Key1, Order1, Key2, Type, Order2, Key3, Order3, Header, OrderCustom, MatchCase, Orientation, SortMethod, DataOption1, DataOption2, DataOption3)keyはソートのキーとなるセルを指定します。
今回はG2を指定します。
orderでは昇順か降順を設定できます。
今回は降順としたいので、xlDescendingとします。
昇順にしたい型は、xlAscendingとしましょう。
headerはソートをかける場合先頭セルをタイトルとみなすかどうか？を設定します。
今回はTOTALというタイトルになっていますので、xlyesとします。
VBAコードは以下です。
A1セルが入っているセルの塊を選択するのがCurrentRegionです。
上記説明の通り、key1、order1、headerを設定しました。
画像の実行結果の通り、降順でソートがかかりましたね。
Sub ソート()
k = Worksheets.Count
Sheets(1).Range("A1").Select
Range("A1").CurrentRegion.Sort _
key1:=Cells(2, k + 1), _
order1:=xlDescending, _
Header:=xlYes
End Sub
7．罫線を付加する
最後に罫線を付加します。
VBAコードは以下です。
前章と同様にCurrentRegionを使って範囲選択し、罫線を付加しました。
今回は単線を全体に付加していますが、項目を二重線で分けたい場合などはもう少し複雑になります。
そういうことがしたい方はこちらの記事をご覧ください。
画像が実行結果です。
ゴールの表を得ることができました。
Sub 罫線()
Sheets(1).Range("A1").Select
Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End Sub
8．表を自動作成するVBAコード
ここまで解説してきた内容を、すべてまとめると以下のようなVBAコードになります。
自動作成といっても、前提がとても大事です。
今回の例でいえば、各科目のシートのA列に同じ順で氏名を記入する、B列に点数を記入する、集計用のシートを1番目とするなど。
前提条件、ルールを決めてうまく活用しましょう。
Sub 表の自動作成()
Dim i, j, k As Long
Sheets(1).Cells.Clear
Sheets(2).Range("A:A").Copy Sheets(1).Range("A1")
k = Worksheets.Count
i = 2
For i = 2 To k
Sheets(i).Range("B:B").Copy Sheets(1).Cells(1, i)
Next
Sheets(1).Cells(1, k + 1).Value = "TOTAL"
j = 2
Do While Cells(j, 1) <> ""
Sheets(1).Cells(j, k + 1).Value = WorksheetFunction.Sum(Range(Cells(j, 2), Cells(j, k)))
j = j + 1
Loop
Sheets(1).Range("A1").Select
Range("A1").CurrentRegion.Sort _
key1:=Cells(2, k + 1), _
order1:=xlDescending, _
Header:=xlYes
Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
End Sub9．まとめ
本記事では『VBAで各シートのセルのデータを集めて表を自動作成する方法』について解説しましたが、いかがでしたか？
マクロをうまく活用するには、事前のルール決めも大事です。
前提をしっかり決めて、自動作成のコードを適用していきましょう。
