行と列の項目が一致する分の転記（クロス抽出)がうまくいかない理由について

Question

表題の通りとなるのですが、
結論、列の項目（複数列）と行の項目と一致した場合、
転記させる処理を試みているのですが中々うまく書き出しができない（何も転記されていない)状況にあります。
※エラー表示はされないものの、意図通りに転記されない

思い当たる節としては、列の項目にある月日の部分が引っかかっています。
また他に自分の持つ配列に対する認識が誤っている可能性もありますが、
有識者の方のお力をお借りしたくご質問させていただきました。

またこういった処理も含めて様々な処理を行うことができると思うのですが、
適した処理方法がございましたらご教示頂けますと幸いです。

(それぞれの項目を変数としてループ処理する方法や
workfunctionを用いての処理を施すなど様々な方法があるかと思いますが、
今回は配列として処理を検討しております。)

Sub 一致転記()

    Dim ws01, ws02 As Worksheet
    Dim Dic As Object
    Dim keys As String
    Dim I, L, mRow, mCol As Long
    Dim X, Y, mRow2, mCol2 As Long
 
    
    Set Dic = CreateObject("Scripting.Dictionary") ' 配列の定義
    
    Set ws01 = Worksheets("編集")
    Set ws02 = Worksheets("転記")
    
    mRow = ws01.Cells(Rows.Count, "C").End(xlUp).Row   '最終行取得
    mCol = ws01.Cells(7, Columns.Count).End(xlToLeft).Column '最終列取得
    
Application.ScreenUpdating = False
    With ws01 ' 配列へ登録
        For L = 8 To mRow ' 範囲(列)指定
        For I = 18 To mCol '範囲(行)指定
        
             keys = .Cells(L, "B") & .Cells(7, I) & .Cells(8, I)
            Dic(keys) = keys
        Next I
        Next L
    End With
  


    With ws02
    
    mRow2 = ws02.Cells(Rows.Count, "C").End(xlUp).Row   '最終行取得
    mCol2 = ws02.Cells(3, Columns.Count).End(xlToLeft).Column '最終列取得
                  
        For X = 4 To mRow2 ' 転記表の範囲(行)指定
        For Y = 4 To mCol2 ' 転記表の範囲(列)指定
            
                keys = .Cells(X, "B") & .Cells(2, Y) & .Cells(3, Y)
                
                .Cells(Y, X) = Dic(keys)
        Next Y
        Next X
    End With
    

Application.ScreenUpdating = True
End Sub

Answer 1

配列自体が動いてるのかステップイン形式・ローカルにて確認
配列自体は正常に?動いてるが、キーに紐づくデータ(item)が格納されていないことが判明したため、
キーに紐づくitemを追加したことにより無事転記された。

また範囲指定の開始位置がずれていることや当初のコードにある変数"X"と"Y"の組み合わせが逆になっていたため、合わせて修正。'.Cells(Y, X)→.Cells(X, Y)'

Option Explicit

Sub 一致転記()

    Dim ws01, ws02 As Worksheet
    Dim Dic As Object
    Dim keys As String
    Dim I, L, mRow, mCol As Long
    Dim X, Y, mRow2, mCol2 As Long
 
    
    Set Dic = CreateObject("Scripting.Dictionary") ' 配列の定義
    
    Set ws01 = Worksheets("編集")
    Set ws02 = Worksheets("転記")
    
    mRow = ws01.Cells(Rows.Count, "C").End(xlUp).Row   '最終行取得
    mCol = ws01.Cells(7, Columns.Count).End(xlToLeft).Column '最終列取得
    
Application.ScreenUpdating = False
    With ws01 ' 配列へ登録
        For L = 8 To mRow ' 範囲(行)指定
        For I = 4 To mCol '範囲(列)指定
        
             keys = .Cells(L, "B") & .Cells(6, I) & .Cells(7, I)
            Dic(keys) = Dic(keys) + .Cells(L, I)
        Next I
        Next L
    End With
  


    With ws02
    
    mRow2 = ws02.Cells(Rows.Count, "B").End(xlUp).Row   '最終行取得
    mCol2 = ws02.Cells(3, Columns.Count).End(xlToLeft).Column '最終列取得
                  
        For X = 4 To mRow2 ' 転記表の範囲(行)指定
        For Y = 4 To mCol2 ' 転記表の範囲(列)指定
            
                keys = .Cells(X, "B") & .Cells(2, Y) & .Cells(3, Y)
                
                .Cells(X, Y) = Dic(keys)
        Next Y
        Next X
    End With
    

Application.ScreenUpdating = True
End Sub