投稿日:

【Excel】各シートの値を集計する

①マクロを使えるようにする
「マクロを使えるようにする」を参照

②集計表のタイトルを用意

③集計するシートを用意

④集計用ボタンを配置

⑤ボタン配置時の以下の画面で「マクロ名」を「Aggregate」として「新規作成」を押す

⑥「Microsoft Visual Basic for Applications」にて以下のコードを記載
※★の部分を作成するレイアウトに合わせて修正

Sub Aggregate()
Dim sheet As Worksheet
'「集計」シートのシート名
Dim aggregateSheetName As String: aggregateSheetName = "集計" '★
'「集計」シートで大学名を表示する列
Dim collegeNameCol As Integer: collegeNameCol = 2 '★
'開始行
Dim startRow As Integer: startRow = 3 '★
'最終行
Dim lastRow As Integer: lastRow = Sheets(aggregateSheetName).Cells(Rows.Count, collegeNameCol).End(xlUp).Row + 1
'各シートで大学名が記載されたCell
Dim collegeNameCell As String: collegeNameCell = "A4" '★

'一旦行をすべてクリア
For i = startRow To lastRow - 1 Step 1
Rows(3).Delete
Next

'全てのシート分繰り返し処理
For Each sheet In Sheets
'「集計」シートの場合は何もしないで次のシートへ
If sheet.Name = aggregateSheetName Then
GoTo CONTINUE
End If

'最終行の再取得
lastRow = Sheets(aggregateSheetName).Cells(Rows.Count, collegeNameCol).End(xlUp).Row + 1

'各シートの大学名が記載されたCellの値を取得
Dim collegeName As String: collegeName = sheet.Range(collegeNameCell).Value

'「集計」シートのB列を３行目から最終行まで走査
For i = startRow To lastRow - 1 Step 1
'一致する行がある場合はC列に１を加算
If Cells(i, collegeNameCol).Value = collegeName Then
Cells(i, collegeNameCol + 1).Value = Cells(i, collegeNameCol + 1).Value + 1
'次のシートへ
GoTo CONTINUE
End If
Next

'最終行まで一致する行がなかった場合
If i = lastRow Then
'最終行のB列に大学名を代入
Cells(i, collegeNameCol).Value = collegeName
'C列に１を加算
Cells(i, collegeNameCol + 1).Value = Cells(i, collegeNameCol + 1).Value + 1
'罫線を引く
Cells(i, collegeNameCol).Borders.LineStyle = xlContinuous
Cells(i, collegeNameCol + 1).Borders.LineStyle = xlContinuous
End If
CONTINUE:
Next
End Sub

⑦「集計」ボタンを押すと各シートの値が集計される