【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列を3行目から最終行まで走査
For i = startRow To lastRow - 1 Step 1
'一致する行がある場合はC列に1を加算
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列に1を加算
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

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

【Excel】フィルターで並び替えを行う②

①フィルターを設定する
フィルターで並び替えを行う①」を参照

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

③並び替え用のボタンを配置

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

⑤「Microsoft Visual Basic for Applications」にて以下のコードを記載

'最終行の取得
Dim lastRow As Integer:
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
'2列目の5行目から最終行に対して昇順のソート
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Range(Cells(5, 2), Cells(lastRow, 2)), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

⑥ボタンの名前を変更する

⑦降順のボタンを作成
ボタンを配置し、「マクロ名」を「TitleDesc」とする


コードは以下のようにする(「Order:=xlDescending」の部分が違うのみ)

'最終行の取得
Dim lastRow As Integer:
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
'2列目の5行目から最終行に対して降順のソート
ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add2 Key:=Range(Cells(5, 2), Cells(lastRow, 2)), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With