マッチングのサンプル。

構造化プログラムの良いところのひとつにマッチング処理が簡単に作成できる点があります。ここでサンプルを作成して見ましょう。
INDEXの始まりは「0」なのか「1」なのか   VB(.NET)もVBAも、デフォルトの配列要素の最小は「0」です。
C(C#)やJava等でもこれは同じなので、先々の言語の乗り換えなども考慮するとこのままで行った方が良いのですが、VBAでは配列を初期化(ReDim)する時の要素数最小値自体が「0」なので、UBound関数で要素数を参照するのにデータが格納された「0」なのか、格納されていない「0」なのかが区別つきません。
このため、VBAのプログラムとしては、配列要素の最小を「1」として扱うことがあります。 何よりも「ファイルを開く」のGetOpenFilename関数で複数ファイル選択可(MultiSelect=True)とした時の戻り値配列も「1始まり」だとか、そもそもシートの行列番号も「1始まり」だとかということがあって、このページも以前は「1始まり」で説明していたのですが、VBAだけに特化した方法では「今後のためのならない」ということも考えて、他言語同様に「0始まり」に変更しました。

 別の章で説明している「VisualBasic(VB.NET)」では配列の初期化(ReDim)で「-1」が使えるので、通常の「0始まり」でも要素数(GetUpperBound)を問い合わせて「-1」なら要素無し、「0」なら1件格納済みだと判断できます。

 なお、これはVBA内部処理での配列の話です。Excelの行列番号は「1」始まりなのは変更できません。
「売上累積データに当日の売上データを更新する」というサンプルです。(04_Matching1.xlsm)
ちょっと古くさいサンプルですが、我慢して下さい。結果としては、そのまま累積の後ろに当日データを付け加えて並べ替えれば済むものですが、あえて並び替えずにマッチングで処理してみます。
累積データは、このようになっています。
累積データのイメージ
(画像をクリックすると、このサンプルがダウンロードできます)
このように、1日から4日までの売上累積が保持されています。
これに対して、当日データはこのようになっています。
当日データのイメージ
これら2つのシートは、それぞれ部門、大分類、小分類、日付の昇順に並んでいます。
今回のマッチング処理とは、この2シートを1つのシートにまとめる処理ですが、並び替えを行なわずにまとめた後も部門、大分類、小分類、日付の昇順を崩さないという処理です。
前提条件は、累積シート、当日シートともに部門＞大分類＞小分類＞日付の順に並べ替えられていることです。

マッチングの「モジュール構成図」を考えるのは少し難しいのですが．．．
できた構成図自体はあまり複雑には見えません。
マッチングのモジュール構成図
ですが、この「箱」の中の説明をよく理解されないと、マッチングがどうして簡単なのかが理解できないので注意して下さい。
(1)全体制御 ①「全体前処理」を行なう。
②「全体主処理」を「累積」、「当日」両方の行が完了するまで繰り返して行なう。
③「全体後処理」を行なう。
(2)全体前処理 ①処理最大行数を取得する。(「累積」、「当日」の両方)
②「累積」の先頭行のキー情報を取得する。
③「当日」の先頭行のキー情報を取得する。
④「翌日累積」の先頭行をセットし、シートを初期化する。
(3)全体主処理 ①「最小キー判定処理」を行なう。判定したキーは直前キーにセットする。
②「累積更新処理」を現在キーが直前キーとブレークするまで繰り返して行なう。
③「当日更新処理」を現在キーが直前キーとブレークするまで繰り返して行なう。
(4)全体後処理 ①「翌日累積」を表示する。
(5)最小キー判定処理 ①「累積」、「当日」の現在キーの内、小さい方を直前キーにセットする。
(6)累積更新処理 ①「翌日累積」の現在行を加算する。
②「累積」の行を「翌日累積」に転記する。
③「累積」の行を加算する。
④「累積」の現在行のキー情報を取得する。
(7)当日更新処理 ①「翌日累積」の現在行を加算する。
②「当日」の行を「翌日累積」に転記する。
③「当日」の行を加算する。
④「当日」の現在行のキー情報を取得する。
※マッチング処理がこれだけなのか、経験がある人は不思議に思うかも知れません。

では、プログラム構造の考え方がまとまったら、コード化して見ましょう。
ここからは、数行になってしまう「箱」はプロシージャとして分けず、直接上位プロシージャの中に記述してしまいますが、コメントで線を引くなどして区別できるようにしておきます。

'***************************************************************************************************
'   当日データを累積データに追加するサンプル                        Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'16/11/19(1.00)新規作成
'19/12/10(1.01)記述共通化・整理
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsSh1 As String = "累積"
Private Const g_cnsSh2 As String = "当日"
Private Const g_cnsSh3 As String = "翌日累積"
Private g_cnsEofBumon As String                                     ' EOF代替値
Private g_cnsEofOther As String                                     ' EOF代替値

'***************************************************************************************************
'   ■■■ 単独起動処理 ■■■
'***************************************************************************************************
'* 処理名　：累積更新処理
'* 機能　　：当日データを累積データに追加するサンプル
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub 累積更新処理()
    '-----------------------------------------------------------------------------------------------
    Dim objWbk As Workbook                                          ' 本BOOK
    Dim objSh1 As Worksheet                                         ' 累積シート
    Dim objSh2 As Worksheet                                         ' 当日シート
    Dim objSh3 As Worksheet                                         ' 翌日累積シート
    Dim lngRow1 As Long                                             ' 累積シート行
    Dim lngRow2 As Long                                             ' 当日シート行
    Dim lngRow3 As Long                                             ' 翌日累積シート行
    Dim lngRowMax1 As Long                                          ' 累積シート最終行
    Dim lngRowMax2 As Long                                          ' 当日シート最終行
    Dim strCurr1 As String                                          ' 累積キー
    Dim strCurr2 As String                                          ' 当日キー
    Dim strPrev As String                                           ' 直前キー(ブレーク判定)
    '-----------------------------------------------------------------------------------------------
    ' ■全体前処理
    Set objWbk = ThisWorkbook                               ' 本BOOK
    Set objSh1 = objWbk.Worksheets(g_cnsSh1)                ' 累積シート
    Set objSh2 = objWbk.Worksheets(g_cnsSh2)                ' 当日シート
    Set objSh3 = objWbk.Worksheets(g_cnsSh3)                ' 翌日累積シート
    g_cnsEofBumon = Chr(255)                                ' EOF代替値(定数利用)
    g_cnsEofOther = Chr(255) & Chr(255)                     ' EOF代替値(定数利用)
    ' 累積のシートの最大行の取得
    With objSh1
        ' フィルタ解除(念の為)
        If .FilterMode Then .ShowAllData
        lngRowMax1 = .Range("$A$" & .Rows.Count).End(xlUp).Row
    End With
    ' 当日のシートの最大行の取得
    With objSh2
        ' フィルタ解除(念の為)
        If .FilterMode Then .ShowAllData
        lngRowMax2 = .Range("$A$" & .Rows.Count).End(xlUp).Row
    End With
    ' 翌日シート累積クリア
    With objSh3
        .Rows("2:" & .Rows.Count).ClearContents
    End With
    ' 先頭キー判定(累積シート)
    lngRow1 = 2
    strCurr1 = FP_GetNewKey(lngRow1, objSh1, lngRowMax1)
    ' 先頭キー判定(当日シート)
    lngRow2 = 2
    strCurr2 = FP_GetNewKey(lngRow2, objSh2, lngRowMax2)
    ' 翌日累積先頭行
    lngRow3 = 1
    '-----------------------------------------------------------------------------------------------
    ' ■全体主処理
    Do While ((lngRow1 <= lngRowMax1) Or (lngRow2 <= lngRowMax2))
        '-------------------------------------------------------------------------------------------
        ' 最小ｷｰ判定処理(→PREV)
        strPrev = strCurr1
        If strCurr2 < strCurr1 Then strPrev = strCurr2
        '-------------------------------------------------------------------------------------------
        ' 累積側の更新処理
        Do While strCurr1 = strPrev
            ' 翌日累積の行を加算
            lngRow3 = lngRow3 + 1
            ' 翌日累積に累積側を転記(1行の横セル範囲で転記)
            objSh3.Cells(lngRow3, 1).Resize(, 8).Value = _
                objSh1.Cells(lngRow1, 1).Resize(, 8).Value
            ' 累積側行を加算
            lngRow1 = lngRow1 + 1
            ' 累積側新キー判定
            strCurr1 = FP_GetNewKey(lngRow1, objSh1, lngRowMax1)
        Loop
        '-------------------------------------------------------------------------------------------
        ' 当日側の更新処理
        Do While strCurr2 = strPrev
            ' 翌日累積の行を加算
            lngRow3 = lngRow3 + 1
            ' 翌日累積に当日側を転記(1行の横セル範囲で転記)
            objSh3.Cells(lngRow3, 1).Resize(, 8).Value = _
                objSh2.Cells(lngRow2, 1).Resize(, 8).Value
            ' 当日側行を加算
            lngRow2 = lngRow2 + 1
            ' 当日側新キー判定
            strCurr2 = FP_GetNewKey(lngRow2, objSh2, lngRowMax2)
        Loop

    Loop
    '-----------------------------------------------------------------------------------------------
    ' ■全体後処理
    objSh3.Select
End Sub

'***************************************************************************************************
'* 処理名　：FP_GetNewKey
'* 機能　　：新キー判定処理(共通処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：新キー値(String)
'* 引数　　：Arg1 = 現在行INDEX(Long)
'* 　　　　　Arg2 = 処理シート(Object)
'* 　　　　　Arg3 = 最終行INDEX(Long)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Function FP_GetNewKey(ByVal lngRow As Long, _
                              ByVal objSh As Worksheet, _
                              ByVal lngRowMax As Long) As String
    '-----------------------------------------------------------------------------------------------
    Dim strBumon As String * 1                                      ' 部門
    Dim strDai As String * 2                                        ' 大分類
    Dim strSyo As String * 2                                        ' 小分類
    Dim strHi As String * 2                                         ' 日付
    ' 有効行範囲か
    If lngRow <= lngRowMax Then
        With objSh
            strBumon = .Cells(lngRow, 1).Value              ' 部門
            strDai = .Cells(lngRow, 3).Value                ' 大分類
            strSyo = .Cells(lngRow, 5).Value                ' 小分類
            strHi = Format$(.Cells(lngRow, 7).Value, "00")  ' 日
        End With
    Else
        ' 最終行到達後は強制ブレークのコード値(EOF)をｾｯﾄ
        strBumon = g_cnsEofBumon
        strDai = g_cnsEofOther
        strSyo = g_cnsEofOther
        strHi = g_cnsEofOther
    End If
    ' ブレーク判定キーは桁位置を揃えて接合
    FP_GetNewKey = strBumon & strDai & strSyo & strHi
End Function

'------------------------------------------<< End of Source >>--------------------------------------
このサンプルでは、部門、大分類、小分類の各コードは桁数を固定しているので、ブレークの判定のために各コードを1つの文字列型変数に格納していますが、「累積」「当日」の両方から共通処理(FP_GetNewKey)として切り出しています。

さて、「構造化プログラム」でのマッチング処理は、どっちのキーが小さいかという判断を行ないません。
先に最小キーを判定しておいて、各入力情報は現在キーが先に判定しておいた最小キーと一致していれば処理するという方法を採ります。サンプルは同一キーの重複はありませんが、コードは重複にも対応しています。
この考え方では、入力情報の数が今回の「累積」「当日」のように2種類ではなく、3種類、4種類となっても、「モジュール構成図」の下段右の「箱」を右に増やしていくだけで対処が可能なのです。

別の観点での「マッチング」サンプルを作ってみましょう。

「マッチング」自体にピンと来ていない方のために、別のサンプルを作ってみましょう。
「日別売上」から「商品別売上」を算出するというサンプルです。(04_Matching2.xlsm)
「日別売上」のイメージ
(画像をクリックすると、このサンプルがダウンロードできます)
簡単なサンプルですが、1日から5日までの「商品コード」と「売上金額」が並んでいるものと考えて下さい。各日付ごとに「商品コード」順に並べ替えてあることが前提条件になりますが、売上が発生する「商品コード」が日ごとに違うため、同じ「商品コード」を横方向に串刺しさせての計算ができません。

「商品別売上」のイメージ(処理前)
そこで、これを別シートに「商品コード」が横に揃う形で転記させて、右端に合計列を作成しようというものです。

「商品別売上」のイメージ(処理後)
処理結果は、このようになります。合計列の「金額」はSUMIF関数で見出しの「金額」を参照させて各行の金額を合計させています。

では、どんなコードになるのでしょう。

'***************************************************************************************************
'   商品別売上の作成(マッチングのサンプル)                          Module1(Module)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'16/11/19(1.00)新規作成
'19/12/10(1.01)記述共通化・整理
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsSh1 As String = "日別売上"
Private Const g_cnsSh2 As String = "商品別売上"
Private Const g_cnsMaxIx As Long = 4                                ' 最終インデックス値(月数-1)
Private Const g_cnsCol2 As Long = 11                                ' 商品別売上の合計列
Private g_cnsEOF As String                                          ' 最終ブレークキー(定数利用)

'***************************************************************************************************
'   ■■■ 単独起動処理 ■■■
'***************************************************************************************************
'* 処理名　：商品別売上作成
'* 機能　　：商品別売上の作成(マッチングのサンプル)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub 商品別売上作成()
    '-----------------------------------------------------------------------------------------------
    Dim objWbk As Workbook                                          ' 本BOOK
    Dim objSh1 As Worksheet                                         ' 日別売上シート
    Dim objSh2 As Worksheet                                         ' 商品別売上シート
    Dim tblRow(g_cnsMaxIx) As Long                                  ' 日別売上の参照行
    Dim tblRowMax(g_cnsMaxIx) As Long                               ' 日別売上の最終行
    Dim tblCurr(g_cnsMaxIx) As String                               ' 日別売上の現在キー(コード)
    Dim strPrev As String                                           ' 最小キー(コード)
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim lngRow As Long                                              ' 行(Work)
    Dim lngRow2 As Long                                             ' 商品別売上の登録行
    Dim lngCol As Long                                              ' カラム
    Dim lngCol2 As Long                                             ' カラム
    Set objWbk = ThisWorkbook                               ' 本BOOK
    Set objSh1 = objWbk.Worksheets(g_cnsSh1)                ' 日別売上シート
    Set objSh2 = objWbk.Worksheets(g_cnsSh2)                ' 商品別売上シート
    g_cnsEOF = String(6, Chr(255))                          ' 最終ブレークキー(定数利用)
    ' 商品別売上側の(加算されるので1行手前)
    lngRow2 = 2
    With objSh2
        .Rows("3:" & .Rows.Count).ClearContents
    End With
    '-----------------------------------------------------------------------------------------------
    ' ■前処理
    '-----------------------------------------------------------------------------------------------
    lngRow = objSh1.Rows.Count
    ' 最終行の判定、初回キーセットを行なう
    For lngIx = 0 To g_cnsMaxIx
        ' インデックスに対する列位置の計算
        lngCol = lngIx * 2 + 1
        ' 先頭行をセット(加算されるので1行手前)
        tblRow(lngIx) = 2
        ' 当該列の最終行を取得
        tblRowMax(lngIx) = objSh1.Cells(lngRow, lngCol).End(xlUp).Row
        ' 次行のキーセット
        Call GP_GetNewKey(objSh1, lngIx, lngCol, tblRow, tblRowMax, tblCurr)
    Next lngIx
    '-----------------------------------------------------------------------------------------------
    ' ■主処理
    '-----------------------------------------------------------------------------------------------
    ' 各列の終了まで繰り返す
    Do
        ' 最小キー判定
        strPrev = g_cnsEOF
        For lngIx = 0 To g_cnsMaxIx
            ' 低い値をブレークキーにセット
            If tblCurr(lngIx) < strPrev Then strPrev = tblCurr(lngIx)
        Next lngIx
        ' 終了判定
        If strPrev = g_cnsEOF Then Exit Do
        ' 商品別売上側の行を加算
        lngRow2 = lngRow2 + 1
        ' 参照キーと一致する場合のみ商品別売上に転記
        For lngIx = 0 To g_cnsMaxIx
            ' 一致判定(マッチング)
            If tblCurr(lngIx) = strPrev Then
                ' インデックスに対する列位置の計算
                lngCol = lngIx * 2 + 1
                ' コードの転記
                objSh2.Cells(lngRow2, lngCol).Value = strPrev
                ' 合計列にもコードを転記
                objSh2.Cells(lngRow2, g_cnsCol2).Value = strPrev
                ' 金額の転記
                lngCol2 = lngCol + 1
                objSh2.Cells(lngRow2, lngCol2).Value = objSh1.Cells(tblRow(lngIx), lngCol2).Value
                ' 次行のキーセット
                Call GP_GetNewKey(objSh1, lngIx, lngCol, tblRow, tblRowMax, tblCurr)
            End If
        Next lngIx
    Loop
    '-----------------------------------------------------------------------------------------------
    ' ■後処理
    '-----------------------------------------------------------------------------------------------
    ' 合計列の計算式(SUMIF関数)のセット
    With objSh2
        lngCol = g_cnsCol2 + 1
        .Range(.Cells(3, lngCol), .Cells(lngRow2, lngCol)).FormulaR1C1 = _
            "=SUMIF(R2C2:R2C[-2],""金額"",RC2:RC[-2])"
        .Activate
    End With
End Sub

'***************************************************************************************************
'* 処理名　：GP_GetNewKey
'* 機能　　：次行のキーセット(共通処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 処理シート(Object)
'* 　　　　　Arg2 = 現在INDEX(Long)
'* 　　　　　Arg3 = カラムINDEX(Long)
'* 　　　　　Arg4 = 行INDEXテーブル(Array:Long)         ※Ref参照
'* 　　　　　Arg5 = 最終行INDEXテーブル(Array:Long)
'* 　　　　　Arg6 = 現在キーテーブル(Array:String)      ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_GetNewKey(ByRef objSh1 As Worksheet, _
                         ByVal lngIx As Long, _
                         ByVal lngCol As Long, _
                         ByRef tblRow() As Long, _
                         ByRef tblRowMax() As Long, _
                         ByRef tblCurr() As String)
    '-----------------------------------------------------------------------------------------------
    tblRow(lngIx) = tblRow(lngIx) + 1
    ' 有効行か
    If tblRow(lngIx) <= tblRowMax(lngIx) Then
        tblCurr(lngIx) = Trim(objSh1.Cells(tblRow(lngIx), lngCol).Value)
    Else
        tblCurr(lngIx) = g_cnsEOF
    End If
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
ループ中で最小キーを判定して、その最小キーと合致する日付を合計シートに転記させていますが、1日から5日（日付テーブルの最終のINDEX「4」は変えられるように定数宣言させています）はループ処理にできるように行位置などを配列に保持させているわけです。
一見、難しい処理のようですが、コードは結構短いもののなっていますから、内容の確認するのも簡単ではないでしょうか。
5日間の処理の要素数はゼロ始まりなので「4」ですが定数宣言させていますから、この

Private Const g_cnsMaxIx As Long = 4                                ' 最終インデックス値
Private Const g_cnsCol2 As Long = 11                                ' 商品別売上の合計列
を

Private Const g_cnsMaxIx As Long = 30                               ' 最終インデックス値
Private Const g_cnsCol2 As Long = 63                                ' 商品別売上の合計列
に替えるだけで、31日分の処理に変更できます。
「モジュール構成図」を書くのが難しいのですが、上にある「モジュール構成図」から考えると、「全体主処理」の下にある「累積更新処理」「当日更新処理」はここでは1つなのですが、それを横に日数分並べたような形を考えると良いでしょう。実際には「同じものを日数分並べる」のではなく、「日数位置を変異させて日数分繰り返す」となっているわけです。

さらに「日別売上」が明細レベルだったらどうでしょう。(04_Matching3.xlsm)
これからがマッチング処理の「本領」なのかも知れません。
上のサンプルの「日別売上」は、最初から１つの「商品コード」が１行になっているわけで、すでに「商品コード」単位の合計処理が行なわれた結果となっています。
これが売上単位の明細の状態だったとしたら、同じ「商品コード」が何行も重複して発生するわけです。
ここでは、その状態を仮に同じ「商品コード」の行をそれぞれの日ごとに3行づつ作成させてみました。
「日別売上」のイメージ
(画像をクリックすると、このサンプルがダウンロードできます)
単純に、各日ごとの内容を3件づつにして「商品コード」順に並び替えています。このため、処理結果は上のサンプルに「3倍」の金額になるはずです。この並び替えは処理の前提条件になります。

「商品別売上」のイメージ(処理後)
どうでしょうか。「商品コード」は同じ発生件数で、同じ「商品コード」は「金額」が「3倍」になっているでしょうか。

ここで見てもらいたいのは、「コードがどれだけ変わったのか」なのです。

'***************************************************************************************************
'   商品別売上の作成(マッチングのサンプル)
'
'   作成者:井上治  URL:https://www.ne.jp/asahi/excel/inoue/ [Excelでお仕事!]
'***************************************************************************************************
'変更日付 Rev  変更履歴内容------------------------------------------------------------------------>
'16/11/19(1.00)新規作成
'19/12/10(1.01)記述共通化・整理
'***************************************************************************************************
Option Explicit
'===================================================================================================
Private Const g_cnsSh1 As String = "日別売上"
Private Const g_cnsSh2 As String = "商品別売上"
Private Const g_cnsMaxIx As Long = 4                                ' 最終インデックス値(月数-1)
Private Const g_cnsCol2 As Long = 11                                ' 商品別売上の合計列
Private g_cnsEOF As String                                          ' 最終ブレークキー(定数利用)

'***************************************************************************************************
'   ■■■ 単独起動処理 ■■■
'***************************************************************************************************
'* 処理名　：商品別売上作成
'* 機能　　：商品別売上の作成(マッチングのサンプル)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：(なし)
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Sub 商品別売上作成()
    '-----------------------------------------------------------------------------------------------
    Dim objWbk As Workbook                                          ' 本BOOK
    Dim objSh1 As Worksheet                                         ' 日別売上シート
    Dim objSh2 As Worksheet                                         ' 商品別売上シート
    Dim tblRow(g_cnsMaxIx) As Long                                  ' 日別売上の参照行
    Dim tblRowMax(g_cnsMaxIx) As Long                               ' 日別売上の最終行
    Dim tblCurr(g_cnsMaxIx) As String                               ' 日別売上の現在キー(コード)
    Dim strPrev As String                                           ' 最小キー(コード)
    Dim lngIx As Long                                               ' テーブルINDEX
    Dim lngRow As Long                                              ' 行(Work)
    Dim lngRow2 As Long                                             ' 商品別売上の登録行
    Dim lngCol As Long                                              ' カラム
    Dim lngCol2 As Long                                             ' カラム
    Set objWbk = ThisWorkbook                               ' 本BOOK
    Set objSh1 = objWbk.Worksheets(g_cnsSh1)                ' 日別売上シート
    Set objSh2 = objWbk.Worksheets(g_cnsSh2)                ' 商品別売上シート
    g_cnsEOF = String(6, Chr$(255))                         ' 最終ブレークキー(定数利用)
    ' 商品別売上側の(加算されるので1行手前)
    lngRow2 = 2
    With objSh2
        .Rows("3:" & .Rows.Count).ClearContents
    End With
    '-----------------------------------------------------------------------------------------------
    ' ■前処理
    '-----------------------------------------------------------------------------------------------
    lngRow = objSh1.Rows.Count
    ' 最終行の判定、初回キーセットを行なう
    For lngIx = 0 To g_cnsMaxIx
        ' インデックスに対する列位置の計算
        lngCol = lngIx * 2 + 1
        ' 先頭行をセット(加算されるので1行手前)
        tblRow(lngIx) = 2
        ' 当該列の最終行を取得
        tblRowMax(lngIx) = objSh1.Cells(lngRow, lngCol).End(xlUp).Row
        ' 次行のキーセット
        Call GP_GetNewKey(objSh1, lngIx, lngCol, tblRow, tblRowMax, tblCurr)
    Next lngIx
    '-----------------------------------------------------------------------------------------------
    ' ■主処理
    '-----------------------------------------------------------------------------------------------
    ' 各列の終了まで繰り返す
    Do
        ' 最小キー判定
        strPrev = g_cnsEOF
        For lngIx = 0 To g_cnsMaxIx
            ' 低い値をブレークキーにセット
            If tblCurr(lngIx) < strPrev Then strPrev = tblCurr(lngIx)
        Next lngIx
        ' 終了判定
        If strPrev = g_cnsEOF Then Exit Do
        ' 商品別売上側の行を加算
        lngRow2 = lngRow2 + 1
        ' 参照キーと一致する場合のみ商品別売上に転記
        For lngIx = 0 To g_cnsMaxIx
            ' 一致判定(マッチング)
            Do While tblCurr(lngIx) = strPrev
                ' インデックスに対する列位置の計算
                lngCol = lngIx * 2 + 1
                ' コードの転記
                objSh2.Cells(lngRow2, lngCol).Value = strPrev
                ' 合計列にもコードを転記
                objSh2.Cells(lngRow2, g_cnsCol2).Value = strPrev
                ' 金額の転記(加算)
                lngCol2 = lngCol + 1
                objSh2.Cells(lngRow2, lngCol2).Value = objSh2.Cells(lngRow2, lngCol2).Value + _
                    objSh1.Cells(tblRow(lngIx), lngCol2).Value
                ' 次行のキーセット
                Call GP_GetNewKey(objSh1, lngIx, lngCol, tblRow, tblRowMax, tblCurr)
            Loop
        Next lngIx
    Loop
    '-----------------------------------------------------------------------------------------------
    ' ■後処理
    '-----------------------------------------------------------------------------------------------
    ' 合計列の計算式(SUMIF関数)のセット
    With objSh2
        lngCol = g_cnsCol2 + 1
        .Range(.Cells(3, lngCol), .Cells(lngRow2, lngCol)).FormulaR1C1 = _
            "=SUMIF(R2C2:R2C[-2],""金額"",RC2:RC[-2])"
        .Activate
    End With
End Sub

'***************************************************************************************************
'* 処理名　：GP_GetNewKey
'* 機能　　：次行のキーセット(共通処理)
'---------------------------------------------------------------------------------------------------
'* 返り値　：(なし)
'* 引数　　：Arg1 = 処理シート(Object)
'* 　　　　　Arg2 = 現在INDEX(Long)
'* 　　　　　Arg3 = カラムINDEX(Long)
'* 　　　　　Arg4 = 行INDEXテーブル(Array:Long)         ※Ref参照
'* 　　　　　Arg5 = 最終行INDEXテーブル(Array:Long)
'* 　　　　　Arg6 = 現在キーテーブル(Array:String)      ※Ref参照
'---------------------------------------------------------------------------------------------------
'* 作成日　：2016年11月19日
'* 作成者　：井上　治
'* 更新日　：2019年12月10日
'* 更新者　：井上　治
'* 機能説明：
'* 注意事項：
'***************************************************************************************************
Private Sub GP_GetNewKey(ByRef objSh1 As Worksheet, _
                         ByVal lngIx As Long, _
                         ByVal lngCol As Long, _
                         ByRef tblRow() As Long, _
                         ByRef tblRowMax() As Long, _
                         ByRef tblCurr() As String)
    '-----------------------------------------------------------------------------------------------
    tblRow(lngIx) = tblRow(lngIx) + 1
    ' 有効行か
    If tblRow(lngIx) <= tblRowMax(lngIx) Then
        tblCurr(lngIx) = Trim(objSh1.Cells(tblRow(lngIx), lngCol).Value)
    Else
        tblCurr(lngIx) = g_cnsEOF
    End If
End Sub

'------------------------------------------<< End of Source >>--------------------------------------
どうでしょうか。変更箇所が分かりますか？
変更の要件は２つだけです。「同一コードが複数行発生する」「転記時に同一コードを合計する」この２点です。 コード上もこの２要件の変更だけ行なっています。

ひとつは「同一コードが複数行発生する」の件で、上のサンプルでは、

        For lngIx = 0 To g_cnsMaxIx
            ' 一致判定(マッチング)
            If tblCurr(lngIx) = strPrev Then
このように、単純なIfステートメントであったものを、

        For lngIx = 0 To g_cnsMaxIx
            ' 一致判定(マッチング)
            Do While tblCurr(lngIx) = strPrev
このように、同じ「商品コード」中を繰り返すようにループ処理に変更しています。当然、「End If」も「Loop」に変更されます。

もう一つは、「転記時に同一コードを合計する」です。

                ' 金額の転記
                lngCol2 = lngCol + 1
                objSh2.Cells(lngRow2, lngCol2).Value = objSh1.Cells(tblRow(lngIx), lngCol2).Value
このような「単純転記」だったものを

                ' 金額の転記(加算)
                lngCol2 = lngCol + 1
                objSh2.Cells(lngRow2, lngCol2).Value = objSh2.Cells(lngRow2, lngCol2).Value + _
                    objSh1.Cells(tblRow(lngIx), lngCol2).Value
このように「加算方式」に変更するだけです。

この3番目のサンプルには31日分のマッチングサンプルも含めてあります。
「商品別売上」のイメージ(処理後)
ソースコードがいくらも違わないことを比べてみて下さい。

いかがでしょうか。
変更箇所が少ないのに驚かれたのではないでしょうか。
もう一つ書き加えると、この「商品コード」が重複することを考慮したコードは、そのまま上の「商品コード」が重複しないケースでも使えるのです。 試しにやってみて下さい。前回のサンプル（「商品コード」が重複しない方）にこのコードを貼り付けて動作させてみて下さい。同じ結果になるのが分かるはずです。
マッチングは難しいかも知れません。   この「マッチング」や前ページの「多段集計(コントロールブレークとか言う)」のような処理を一般的(古くから)に「一括処理」とか「バッチ処理」と呼びます。単なる1件のデータの出し入れの仕組みではないものを考えるので、解りにくいですが、上の「モジュール構成図」のように図解できると結構単純です。また、いろいろなパターンを見ても、ここの2例の組み合わせで多くが対応できてしまったりするものです。
古い情報処理の考え方でも「マッチング」は存在します。大抵は2要素のマッチングに止まり、「左のコードが小さい場合」「右のコードが小さい場合」「左右のコードが同じ場合」という3つに処理を切り分けるものです。 これでは「マッチング」の要素が3つを超えると「お手上げ」になってしまうのですが、このページの後半のような考え方ができれば柔軟に対応できるようになります。
「配列」の処理の中で「マッチング」は難しい方になりますが、このページが理解できるなら上級者であろうと思います。 事務系プログラミングでは「配列」は避けては通れないものなので、ぜひ学習して下さい。