とくとくデパートの売上額を求める - 繰り返し処理と動的配列 -

前回、繰り返し処理のネストを使って、行方向と列方向のコーディングについてご紹介しました。
前回はただセルの値を表示するだけという簡単な内容でしたが、今回は実際に値を行列方向に加算し、売上一覧を作ってみたいと思います。
特に、小計値である支店別の月別売上を加算しながら、同時に配列を使用して小計値のみを加算する処理を組み合わせます。
小計値のみの加算には RedimPreserve を使用し、配列の要素数（インデックス番号）を支店数に応じて動的に増やしていきます。
はてなブログにExcelファイルを添付できればよいのですが、できないようなので、適当に値の入った表を作って試して頂ければ幸いです。

処理前の売上一覧

売上一覧処理前

処理後の売上一覧

売上一覧処理後

1. 変数および定数の設定と初期化処理

Sub 売り上げ()
    Dim WS                    As Worksheet
    Dim iGyouCnt              As Long    '行カウンタ
    Dim iRetuCnt              As Long    '列カウンタ
    Dim iLastRow              As Long    '終端行番号
    Dim sumBranchSales        As Long    '月ごとの各支店別売上（小計値）
    Dim sales                 As Long    '売上額（セルに入力されている数値）
    Dim arrSubtotal_Branch()  As Variant '支店ごとの月次売り上げ
    Dim cntBranch             As Long    '配列のインデックスに支店数を使用
    Dim sumMonthly            As Long    '支店ごとの月次売り上げの加算用変数
    Dim sumHalfYear           As Long    '半期の商品別売り上げを格納
    Dim sumAllSales           As Long    '全売り上げの合計値
    
    '行番号
    Const rTOP_PosY           As Long = 2 '表の先頭行番号
    Const rDATA_PosY          As Long = 3 'データの先頭行番号
    
    '列番号
    Const SHITEN_PosX         As Long = 1 '支店列番号
    Const ITEM_PosX           As Long = 2 '商品列番号
    Const cDATA_PosX          As Long = 3 'データの先頭列番号
    
    Set WS = Worksheets("Sheet1")   'Sheet1をオブジェクト変数WSに格納
    
    '終端行の取得
    iLastRow = WS.Cells(Rows.Count, 1).End(xlUp).Row
    
    '列カウンタ初期化
    iRetuCnt = 0
    '行カウンタ初期化
    iGyouCnt = 0

2.支店別売上を入力するための小計行を自動挿入

⇒支店名列を上から下へ走査するだけなので、ループのネストはなし

    Do While (1)
        '支店名列を終端行から上方向に走査、支店名セル(A2セル)を指したら終了
        If WS.Cells(iLastRow - iGyouCnt, SHITEN_PosX).Value = "支店名" Then
            Exit Do
        End If

        '小計行を入力
        If InStr(WS.Cells(iLastRow - iGyouCnt, SHITEN_PosX), "支店") <> 0 And _
           WS.Cells(iLastRow - iGyouCnt - 1, SHITEN_PosX).Value = "" Then
            WS.Rows(iLastRow - iGyouCnt).Insert
            WS.Cells(iLastRow - iGyouCnt, ITEM_PosX).Value = "小計"
            
            '小計セルの下側罫線を引き、上側の罫線を消す
            With WS.Cells(iLastRow - iGyouCnt, SHITEN_PosX)
                .Borders(xlEdgeBottom).LineStyle = xlContinuous
                .Borders(xlEdgeTop).LineStyle = xlLineStyleNone
            End With
        End If
        
        iGyouCnt = iGyouCnt + 1
    Loop
   
    iGyouCnt = 0
    

3.小計値を求める（月ごとの支店別売り上げ）　＆　月別全支店売上を求める

⇒列方向と行方向の合わせ技
（4月A支店→D支店　⇒　5月A支店→D支店　⇒6月⇒7月⇒8月⇒9月A支店→D支店）
4月期A支店の商品aaaから商品eeeの売上を順に加算処理し、小計行を指したら値をセルへ出力
次はB支店の4月を処理、同様にD支店まで処理し、商品列が空白セルを指したら列カウンタをインクリメントし、5月を処理。
〔　加算処理の仕組み　〕
簡単に説明すると
⇒　a=a+b(aは加算値を格納する変数、bは足し込んでいきたい個々のセル値。右辺a+bの結果を左辺へ格納)
⇒ 加算値を格納する変数をカウンタ変数のように使用し、売り上げ額を足し込んでいく
　今回の場合だと、、、
売り上げセルの値が「0」ではない場合【注2】、加算処理【注3】
sumBranchSales の初期値；0ゼロ、A支店の商品aaaの4月の値は125より、
右辺の「sumBranchSales + sales」は sumBranchSales『0』 + sales『125』となり、
左辺のsumBranchSalesには125が代入される。
行カウンタがインクリメント【注4】され、商品bbbの値568が変数 sales に格納される。よって、
右辺のsumBranchSalesには最初の商品aaaの値125が格納されており、変数salesには
新しく商品bbbの値568が格納されている。つまり
右辺 sumBranchSales『125』 + sales『568』　の計算結果693が左辺のsumBranchSalesに格納される【注1】。
これを繰り返し、小計セルに到達【注5】したら、左辺の加算値をセルへ代入する【注6】
セルへ代入後、加算値（sumBranchSales）を初期化【注7】し、 行カウンタがインクリメント【注4】され、次の支店の処理が始まる。
内側ループの終了条件を満たしたら【注8】、外側ループへ移動し終了条件チェックし、
外側終了条件を満たさないなら再び内側ループへ入る、を外側ループの終了条件を満たすまで繰り返す。

    '外側ループ；項目行を走査し、商品別売上合計を指したら終了
    Do While (1)
        If WS.Cells(rTOP_PosY, cDATA_PosX + iRetuCnt).Value = "商品別売上合計" Then
            Exit Do
        End If
        
        '内側ループ；商品列を走査、空白セルを指したら終了
        Do While (1)
            If WS.Cells(rDATA_PosY + iGyouCnt, ITEM_PosX).Value = "" Then  '【注8】
                Exit Do
            End If

            '各売り上げを変数 sales へ格納
            sales = WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value  '【注1】
            '売り上げがゼロではない場合に加算
            If sales <> 0 Then '【注2】
                sumBranchSales = sumBranchSales + sales '【注3】
            End If

            '小計行を指したら、加算値（月ごとの支店別売り上げ）をセルに出力。
            '加算値を初期化する。            
            
            '小計行かどうかをチェック
            If WS.Cells(rDATA_PosY + iGyouCnt, ITEM_PosX).Value = "小計" Then '【注5】
                
                '小計行なら加算してきた値(sumBranchSales)をセルへ出力
                WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value = sumBranchSales '【注6】
                
                '月別の全支店売り上げを求めるために、小計値を順に配列へ格納していきます。
                'この処理は配列を使用せずとも小計値と同様に加算処理でも可能ですが、配列の使い方を紹介したいので、あえて配列を使用します。
                '配列の要素数は支店の数ですが､”支店数の変動に対応する”ために一工夫します。
                '　⇒RedimPreserveを使用して配列の要素数を動的に変動させます。
                '　⇒配列のインデックスには支店の数を表すカウンタ変数(cntBranch)を使用し、配列へ格納するたびにインクリメントします。
                '　⇒こうすることで、要素数を増加させながら配列に値を格納することが可能です。
                '　⇒つまり、条件に合わせて、必要なものを、必要な数だけ、配列に格納することが可能です。
                '　⇒私もこれを見つけた時はほんと感動！
                
                ReDim Preserve arrSubtotal_Branch(cntBranch)
                arrSubtotal_Branch(cntBranch) = sumBranchSales
                
                '支店ごとの月次売上を加算処理する
                '加算値用の変数＝加算値用の変数+小計値のみを格納した配列
                sumMonthly = sumMonthly + arrSubtotal_Branch(cntBranch)
                
                '支店の数をカウントする
                cntBranch = cntBranch + 1
                
                '支店ごとの小計値を初期化し、次の支店の小計値を格納するための処理
                sumBranchSales = 0 '【注7】
            End If
            
            '↓どうしてこの位置で行カウンタをインクリメントしたか？
            ' （ = どうして内側ループのLoopの記述直前★★ではないのか？）
            '内側ループの終了条件が商品列（B列）のセルが空白セルの場合だから。
            '   ⇒D支店の小計値代入後すぐに､月別全支店売上の行かどうかをチェックしても、
            '     小計行のままなので、セルへの出力は実行されず、If文を抜ける。
            '     行カウンタインクリメントで次の行へ移動するものの、空白セルのため、
            '     内側ループの終了条件を満たしてしまい、次別合計をセルへ出力せずに次の列へ移ってしまうから。
            '月別全支店売上のIf文直前で行カウンタをインクリメントさせることで、最後のD支店の小計値を入力後すぐに
            '月別全支店売上のセルを指すことができ､月別全支店売上をセルへ出力することができる｡
            
            '行カウンタをインクリメントし、次の支店へ。
            iGyouCnt = iGyouCnt + 1 '【注4】
            
            '月別全支店売上を指したらセルへ加算値を出力
            If WS.Cells(rDATA_PosY + iGyouCnt, SHITEN_PosX).Value = "月別全支店売上" Then
                WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value = sumMonthly
                sumMonthly = 0
            End If
            
        Loop '★★

        '内側ループを抜けたら
        '  列カウンタをインクリメント ⇒1つ右の列(月)へ
        '  行カウンタを初期化         ⇒A支店に戻す
        iGyouCnt = 0
        iRetuCnt = iRetuCnt + 1
    Loop
       
    '変数の初期化
    iRetuCnt = 0
    cntBranch = 0
        
    '終端行を再取得
    iLastRow = WS.Cells(Rows.Count, 1).End(xlUp).Row
    

4.商品別売上合計を求めます

⇒行ごとに処理を行います

    Do While (1)
        If WS.Cells(rDATA_PosY + iGyouCnt, ITEM_PosX).Value = "" Then
            Exit Do
        End If
        
        Do While (1)
            'C2セルから右方向へ走査し、空白セルのJ列を指したら列カウンタを「0ゼロ」に戻す。
            '⇒つまり4月に戻る
            If WS.Cells(rTOP_PosY, cDATA_PosX + iRetuCnt).Value = "" Then
                iRetuCnt = 0
                Exit Do
            End If
        
            'セルの値が空白セルではない場合、セルの値を加算する
            If WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value <> "" Then
                sumHalfYear _
                = sumHalfYear + WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value
            End If
            
            '商品別売上合計を指したら加算値をセルへ出力し、値を初期化
            If WS.Cells(rTOP_PosY, cDATA_PosX + iRetuCnt).Value = "商品別売上合計" Then
                WS.Cells(rDATA_PosY + iGyouCnt, cDATA_PosX + iRetuCnt).Value = sumHalfYear
                sumHalfYear = 0
            End If

            '月が変わる
            iRetuCnt = iRetuCnt + 1
    
        Loop
    
    'ひとつ下の商品へ移動する
    iGyouCnt = iGyouCnt + 1
    
    Loop
    
    '終端行を再取得
    iLastRow = WS.Cells(Rows.Count, 1).End(xlUp).Row
    

5.全支店全売上額を求める

⇒1行のみの加算処理で列の走査はないので、ループ処理のネストはありません。

    '終端行の1行下に"全支店全売上額"と入力する
    WS.Cells(iLastRow + 1, SHITEN_PosX).Value = "全支店全売上額 "
    
    '月別全支店売上の行を右方向に走査し、空白セルを指したら加算処理を終了し、加算値をセルへ代入、罫線を引き、繰り返し処理を抜ける
    Do While (1)
        If WS.Cells(iLastRow, cDATA_PosX + iRetuCnt).Value = "" Then
            '加算値(全合計)をセルへ代入
            WS.Cells(iLastRow + 1, ITEM_PosX).Value = sumAllSales
            
            With WS.Range( _
                WS.Cells(iLastRow + 1, SHITEN_PosX), WS.Cells(iLastRow + 1, ITEM_PosX)) _
                .Borders(xlEdgeBottom)     'セルの下側に
                .LineStyle = xlContinuous  '罫線(実線 細い)を引き、
                .Weight = xlThick          '太さを太いに設定
            End With
            
            Exit Do '繰り返し処理を抜ける
        End If
        
        '月別全支店売上額を加算処理（加算値＝加算値 + 加算したい個々の値）
        '左辺月ごとに一つずつかか）
        If WS.Cells(iLastRow, cDATA_PosX + iRetuCnt).Value <> "" Then
            sumAllSales = sumAllSales + WS.Cells(iLastRow, cDATA_PosX + iRetuCnt).Value
        End If
        
        '月が変わる
        iRetuCnt = iRetuCnt + 1
    
    Loop

End Sub