VBA基本(目的の機能に改造する。)

以前に説明した一連番号のように、自動記録のマクロはそのまま使うものではありません。

今度は、このような一覧表から、小計・合計のみを集計シートに作成するマクロを作ってみます。

ここでは、データの行数にかかわらず同じマクロを動かして結果が得られることを主目的とします。

(このサンプルがダウンロードできるので、やってみて下さい。)
記録する作業手順は次のようにしてみます。

①: 「明細一覧」の表全体を選択する。
②: 集計機能(小計)を使って「部門」「大分類」「小分類」を集計する。
③: 「集計」シートで集計値を生かすため、集計結果を右の列に値で貼り付ける。(「金額」列自体で値に置き換えると、後で集計状態を元に戻せないため)
④: 集計機能で作成されたグループでの小計行のみのコピーはできないので、オートフィルタで小計行を抽出する。
⑤: 抽出された行だけを「集計」シートにコピーする。「集計」シート側では「金額」列は右の列を有効にする。
⑥: 「明細一覧」に戻ってオートフィルタと集計状態を解除する。

では、やってみましょう。

A1セルの選択も記録に含めるので、一旦、A1以外のセルを選択した状態で「マクロの記録」を起動します。
途中で計算式の投入があるので、R1C1参照形式で説明します。

マクロの記録を起動する。

「表全体の選択」は、A1セルを選択、Ctrl＋Shift＋→、Ctrl＋Shift＋↓、と操作するとできます。

表全体を選択

集計処理は「部門」「大分類」「小分類」の３回行ないます。
リボンの上の名前は「小計」になっています。通常はデータタブの「アウトライン」ブロックにあります。

集計の１回目

この「現在の集計表と置き換える」は最初の「部門」の時だけにします。

集計の２、３回目

続けて「大分類」「小分類」の集計も行ないます。

次に「金額」列を値に貼り替えます。
まず、「金額」の列全体を選択してコピーし、右隣の列(E列とF列)に値の貼り付けを行ないます。
D列自体を値で置き換えないのは、最後に集計の解除を行なう際に元の計算式を残しておく必要があるからです。
F列は後で計算式に置き換えますが、この時Ctrl＋Shift＋↓で最終行が特定できるようにするためです。
何回か「コピー」「貼り付け」を行ないますが、「貼り付け」の後はEscキーを押してコピーモードを解除します。

集計行を値に置き換える。

これでフィルタ等で折りたたんでも、E列に小計行の値は変わらなくなります。

次はオートフィルタで集計行のみを抽出します。
Excel2003まではいきなり「フィルタオプション」で指定ができたのですが、うまく行かないので、右に列を追加して「部門」「大分類」「小分類」の列が「～集計」となっているの行に「○」を付けることにします。

小計の行に「印」をつける。

列の見出しは「小計判定」などとして、以下の式を2行目以降に貼り付けます。


=IF(OR(RIGHT($A2,2)="総計",RIGHT($A2,2)="集計",RIGHT($B2,2)="集計",RIGHT($C2,2)="集計"),"○","")

これで集計行に「○」が表示されるので、フィルタを使って「○」の行だけを表示させます。

小計行のみを抽出する。

次に抽出された集計行範囲を選択してコピーし、「集計」シートに移ってA2セルから貼り付けます。
元の「金額」列は小計行については明細がたたまれているとゼロになってしまうので、隣の値で貼り付けた方の列と入れ替えれます。

最後に、「明細一覧」シートに戻って、オートフィルタを解除し、追加列を削除して集計状態を解除します。

集計状態を解除する。

これで記録されるコードは次のようになるはずです。(画面スクロールなどは削除済み)

※折り返し位置の調整と、操作上での説明をコメントで記述させています。


'***************************************************************************************************
'   集計処理サンプル                                                Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/06/01(1.00)新規作成
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'   ■■■ サンプルマクロ ■■■
'***************************************************************************************************
'* 処理名　：集計処理
'* 機能　　：集計処理サンプル
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年06月01日
'* 作成者　：井上　治
'* 更新日　：2003年06月01日
'* 更新者　：井上　治
'* 機能説明：データタブの「小計」を使って集計を行ないます。
'* 注意事項：自動記録マクロからコメント等を加えて整理だけしたもの
'***************************************************************************************************
Sub 集計処理()
    '-----------------------------------------------------------------------------------------------
    ' 起動時に｢明細一覧｣が選択されていない場合の対策
    Sheets("明細一覧").Select
    ' A1セル起点で表全体を選択(Ctrl+Shift+→,Ctrl+Shift+↓)
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    ' 集計処理を部門、大分類、小分類の3回行なう
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(4), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    ' 金額列をコピーし、右隣(E)列に値で貼り付け
    Columns("D:D").Select
    Selection.Copy
    Columns("E:E").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ' 金額(値)列をさらに右隣(F)列にコピー
    Range("E2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("F2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' F列は計算式に置換え
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "=IF(OR(RIGHT(RC1,2)=""総計"",RIGHT(RC1,2)=""集計""" & _
        ",RIGHT(RC2,2)=""集計"",RIGHT(RC3,2)=""集計""),""○"","""")"
    Range("F2").Select
    Selection.Copy
    Range("F3").Select
    Range(Selection, Selection.End(xlDown)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' F列に見出しを設定
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "小計判定"
    ActiveCell.Characters(1, 2).PhoneticCharacters = "ショウケイ"
    ActiveCell.Characters(3, 2).PhoneticCharacters = "ハンテイ"
    ' F列「○」でオートフィルタ抽出
    Range("A1:F1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$F$1").AutoFilter Field:=6, Criteria1:="<>"
    ' 抽出範囲(見出し含む)をコピー(縦方向が先)
    Range("F1").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToLeft)).Select
    Selection.Copy
    ' 集計シートにコピー
    Sheets("集計").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' 金額の見出しをE列にコピー
    Range("D1").Select
    Selection.Copy
    Range("E1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' 金額(式)列を削除
    Columns("D:D").Select
    Selection.Delete Shift:=xlToLeft
    '「○」列を削除
    Columns("E:E").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    ' 明細一覧のオートフィルタと集計状態を解除
    Sheets("明細一覧").Select
    Selection.AutoFilter
    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    Range("A2").Select
    Selection.RemoveSubtotal
    ' 集計シートを選択して終了
    Sheets("集計").Select
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

このままでも、一応機能はしているようです。

さて、コードを整理してみましょう。

整理したのが、このようなコードになりました。ワークシートの切り替えがあるので、一部のSelectは残しています。


'***************************************************************************************************
'   集計処理サンプル②                                              Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/06/01(1.00)新規作成
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'   ■■■ サンプルマクロ ■■■
'***************************************************************************************************
'* 処理名　：集計処理2
'* 機能　　：集計処理サンプル②
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年06月01日
'* 作成者　：井上　治
'* 更新日　：2003年06月01日
'* 更新者　：井上　治
'* 機能説明：データタブの「小計」を使って集計を行ないます。
'* 注意事項：
'***************************************************************************************************
Sub 集計処理2()
    '-----------------------------------------------------------------------------------------------
    ' 起動時に｢明細一覧｣が選択されていない場合の対策
    Sheets("明細一覧").Select
    ' A1セル起点で表全体を選択(Ctrl+Shift+→,Ctrl+Shift+↓)
    Range(Range("A1"), Range("D1").End(xlDown)).Select
    ' 集計処理を部門、大分類、小分類の3回行なう
    Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    Selection.Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(4), _
        Replace:=False, PageBreaks:=False, SummaryBelowData:=True
    ' 金額列をコピーし、右隣(EとF)列に値で貼り付け
    Columns("D:D").Copy
    Columns("E:F").PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
    ' F列は計算式に置換え
    Range(Range("F2"), Range("F2").End(xlDown)).FormulaR1C1 = _
        "=IF(OR(RIGHT(RC1,2)=""総計"",RIGHT(RC1,2)=""集計""" & _
        ",RIGHT(RC2,2)=""集計"",RIGHT(RC3,2)=""集計""),""○"","""")"
    ' F列に見出しを設定
    Range("F1").Value = "小計判定"
    ' F列「○」でオートフィルタ抽出
    Range("A1:F1").AutoFilter
    ActiveSheet.Range("$A$1:$F$1").AutoFilter Field:=6, Criteria1:="<>"
    ' 抽出範囲(見出し含む)をコピー(F列は除外)
    Range(Range("A1"), Range("E1").End(xlDown)).Copy
    ' 集計シートにコピー
    Sheets("集計").Select
    Range("A1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ' 金額の見出しをE列にコピー
    Range("D1").Copy Destination:=Range("E1")
    Application.CutCopyMode = False
    ' 金額(式)列を削除
    Columns("D:D").Delete Shift:=xlToLeft
    Range("A2").Select
    ' 明細一覧のオートフィルタと集計状態を解除
    Sheets("明細一覧").Select
    Range("A1:F1").AutoFilter
    Columns("E:F").Delete Shift:=xlToLeft
    Range("A2").Select
    Selection.RemoveSubtotal
    ' 集計シートを選択して終了
    Sheets("集計").Select
End Sub

'------------------------------------------<< End of Source >>--------------------------------------

いくらか短くなったでしょうか。

さて、これをもう少し押し進めて、シートやセルの選択を全くせずに進めるように記述を直してみます。

この位まで書けるようになると、元が自動記録だという痕跡は薄くなる上、動作中の画面明滅も無くなります。さらに起動前のシート選択やフィルタ状態にも左右されずに動作します。
特に上の書き方だといきなり「Range」で始まるので、どのシートに作用しているのかが判りにくいですが、こちらの書き方はすべてシートを特定(Withステートメント含む)しているので、判りやすい上誤った動作が起こらない利点があります。


'***************************************************************************************************
'   集計処理サンプル                                                Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'03/06/01(1.00)新規作成
'***************************************************************************************************
Option Explicit

'***************************************************************************************************
'   ■■■ サンプルマクロ ■■■
'***************************************************************************************************
'* 処理名　：集計処理3
'* 機能　　：集計処理サンプル③
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2003年06月01日
'* 作成者　：井上　治
'* 更新日　：2003年06月01日
'* 更新者　：井上　治
'* 機能説明：データタブの「小計」を使って集計を行ないます。
'* 注意事項：
'***************************************************************************************************
Sub 集計処理3()
    '-----------------------------------------------------------------------------------------------
    Dim objSh1 As Worksheet                                         ' 明細一覧シート
    Dim objSh2 As Worksheet                                         ' 集計シート
    ' 画面描画停止､自動計算停止
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With
    ' 各ワークシートを取得(実際は参照の取得)
    Set objSh1 = ThisWorkbook.Worksheets("明細一覧")
    Set objSh2 = ThisWorkbook.Worksheets("集計")
    ' 以下は明細一覧シートの処理(Withブロック：ワークシート)
    With objSh1
        ' オートフィルタを解除
        If .FilterMode Then .ShowAllData
        If .AutoFilterMode Then .Range("A1:F1").AutoFilter
        ' A1セル起点で表全体を選択して、集計を行なう(Withブロック：セル範囲)
        With .Range(.Range("A1"), .Range("D" & .Rows.Count).End(xlUp))
            ' 集計処理を部門、大分類、小分類の3回行なう
             .Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(4), _
                 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
             .Subtotal GroupBy:=2, Function:=xlSum, TotalList:=Array(4), _
                 Replace:=False, PageBreaks:=False, SummaryBelowData:=True
             .Subtotal GroupBy:=3, Function:=xlSum, TotalList:=Array(4), _
                 Replace:=False, PageBreaks:=False, SummaryBelowData:=True
        End With
        ' 再計算(先頭の処置で自動計算は停止している)
        .Calculate
        ' 金額(D列)をE列にコピー
        With .Range(.Range("D2"), .Range("D" & .Rows.Count).End(xlUp))
            .Copy Destination:=Range("E2")
            ' F列に数式をセット
            .Offset(0, 2).FormulaR1C1 = _
                "=IF(OR(RIGHT(RC1,2)=""総計"",RIGHT(RC1,2)=""集計"",RIGHT(RC2,2)=""集計""" & _
                ",RIGHT(RC3,2)=""集計""),""○"","""")"
        End With
        ' 金額列の見出しをE列にコピー
        .Range("D1").Copy Destination:=.Range("E1")
        ' コピーした金額(E列)を値に置換え
        With .Range(.Range("E2"), .Range("E" & .Rows.Count).End(xlUp))
            .Value = .Value
        End With
        ' F列に見出しを設定
        .Range("F1").Value = "小計判定"
        ' オートフィルタを設置
        With .Range("A1:F1")
            .AutoFilter
            ' F列「○」でオートフィルタ抽出
            .AutoFilter Field:=6, Criteria1:="<>"
        End With
        ' 抽出範囲(見出し含む)をコピー(F列は除外)して集計シートに転記
        With .Range(.Range("A1"), .Range("E" & .Rows.Count).End(xlUp))
            .Copy Destination:=objSh2.Range("A1")
        End With
        ' オートフィルタを解除
        .Range("A1:F1").AutoFilter
        ' 追加列(金額(値)列と「○」数式列)を削除
        .Columns("E:F").Delete Shift:=xlToLeft
        ' 集計状態を解除
        .Range(.Range("A1"), .Range("D" & .Rows.Count).End(xlUp)).RemoveSubtotal
        .Cells.ClearOutline
    End With
    ' 以下は集計シートの処理(Withブロック：ワークシート)
    With objSh2
        ' 集計シートを選択(最終的に表示するため)
        .Select
        ' 金額(式)列を削除
        .Columns("D:D").Delete Shift:=xlToLeft
    End With
    ' 画面描画再開､自動計算停止解除
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
    End With
End Sub

'----------------------------------------<< End of Source >>----------------------------------------

このように書けると「With objSh1」～「End With」の間に「Select」や「Selection」が一度も発生しない記述ができます。
ここでは「ScreenUpdating」を止めてはいますが、「Select」、「Selection」がないということは「ScreenUpdating」で画面描画を止めなくても選択セルなどの明滅はないということになります。
コードそのものは長くなってしまいましたが「短くする」が目的ではなく、処理速度を速くして動作を確実なものにするのが目的です。
さらには記述のステップごとにコメントで日本語の説明を埋め込んで後から見た時に「何をやっているのか」が明確に理解できるようにすることも重要です。コメントの説明は自動記録からの変更箇所の説明ではなく、全体動作のすべての説明記述である必要があります。