MW211 EXIT

devlog
ExcelVBA/シートのグループごと集計
2022年01月20日
A列とB列が複合キーでC列の値を集計したい場合のマクロ。
┌──────────────────────────────────────┐
│Option Explicit                                                             │
├──────────────────────────────────────┤
│Public Sub 集計()                                                           │
│    Application.ScreenUpdating = False                                      │
│    Dim yMax As Long, y As Long, yKey As Long                               │
│    With ThisWorkbook.Worksheets("対象名")                                  │
│        Call ソート                                                         │
│        yMax = .UsedRange.Rows(.UsedRange.Rows.Count).Row                   │
│        y = 1                                                               │
│        Do While y <= yMax                                                  │
│            yKey = y                                                        │
│            Do                                                              │
│                If y <> yKey Then                                           │
│                    .Cells(yKey, 3).Value = .Cells(yKey, 3).Value _         │
│                                          + .Cells(y, 3).Value              │
│                    .Rows(y).ClearContents                                  │
│                End If                                                      │
│                y = y + 1                                                   │
│            Loop While y <= .Rows.Count _                                   │
│                And .Cells(y, 1).Value = .Cells(yKey, 1).Value _            │
│                And .Cells(y, 2).Value = .Cells(yKey, 2).Value              │
│        Loop                                                                │
│        Call ソート                                                         │
│    End With                                                                │
│    Application.ScreenUpdating = True                                       │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Sub ソート()                                                        │
│    With ThisWorkbook.Worksheets("対象名")                                  │
│        With .Sort                                                          │
│            With .SortFields                                                │
│                .Clear                                                      │
│                .Add Key:=ThisWorkbook.Worksheets("対象名").Columns(1), _   │
│                     SortOn:=xlSortOnValues, _                              │
│                     Order:=xlAscending, _                                  │
│                     DataOption:=xlSortNormal                               │
│                .Add Key:=ThisWorkbook.Worksheets("対象名").Columns(2), _   │
│                     SortOn:=xlSortOnValues, _                              │
│                     Order:=xlAscending, _                                  │
│                     DataOption:=xlSortNormal                               │
│            End With                                                        │
│            .SetRange ThisWorkbook.Worksheets("対象名").Cells               │
│            .Header = xlYes                                                 │
│            .MatchCase = True                                               │
│            .Orientation = xlTopToBottom                                    │
│            .SortMethod = xlPinYin                                          │
│            .Apply                                                          │
│        End With                                                            │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘
分類:ExcelVBA