VBA100本ノック 25本目：マトリックス表をDB形式に変換

こちらで公開されている、100本ノックに挑戦。
www.excel-ubara.com
素晴らしい教材を公開いただき、ありがとうございます。

上記リンク先から、問題文を転載。

今回のお題は、マトリックス（行列）表からＤＢ（テーブル）形式への変換。
列数は、登場する日付の最大値と最小値の差から求めてみた。従って、例えば
土日が無いなど不連続なデータの場合は成立しない。
※その場合は、使用する列数などで求めるべきか。

行数は、部門数と区分数を変数に持つことで対応。マトリックスから自動で
読み取ってはいないので、確実性には欠けるかもしれない。

ということで、作成したのがこちら。

Sub VBA_100Knock_025()

        Sheets("売上").Select

    ' 日付。
    Dim dMax As Long
        dMax = WorksheetFunction.Max(Rows(1)) - _
               WorksheetFunction.Min(Rows(1)) + 1
    ' 部門数。
    Dim DeptNumber As Long
        DeptNumber = 5
    ' 区分数。
    Dim ItemNumber As Long
        ItemNumber = 2
    ' 並び替えたデータを格納するための配列。
    Dim arr() As Variant
    ReDim arr(dMax * DeptNumber * ItemNumber, 3)
    ' ラベル行のデータ作成。
        arr(0, 0) = "部門"
        arr(0, 1) = "区分"
        arr(0, 2) = "日付"
        arr(0, 3) = "金額"
    
    ' マトリックス形式の表範囲。
    Dim SrcRange As Range
    Set SrcRange = Range("A1").CurrentRegion
    Dim r As Long
    Dim c As Long
    Dim i As Long: i = 1
        For r = 2 To SrcRange.Rows.Count
            For c = 3 To dMax + 2
                ' 結合セル対策。
                If SrcRange(r, 1) = vbNullString Then
                    arr(i, 0) = arr(i - 1, 0)
                Else
                    arr(i, 0) = SrcRange.Cells(r, 1)
                End If
                arr(i, 1) = SrcRange.Cells(r, 2)
                arr(i, 2) = SrcRange.Cells(1, c)
                arr(i, 3) = SrcRange.Cells(r, c)
                i = i + 1
            Next
        Next
    
    Dim Sh As Worksheet
    Set Sh = Sheets.Add
        Sh.Name = "売上ＤＢ"
        Sh.Range("A1").Resize(dMax * DeptNumber * ItemNumber + 1, 4) = arr
End Sub

実行した結果が ↓ こちら。

※冒頭リンク先の解答例および解説も、ぜひご一読ください。

参考まで。