リスト形式→マトリックス表への変換

Question

前提・実現したいこと

VBAでリスト形式の表をマトリックス表に書き換えたいと考えております。
具体的には添付Sheet1からSheet2の表を作成したいのですが残念ながら方法がわからず質問させていただきました。

発生している問題・エラーメッセージ

同じ日付でも行先が異なるため恥ずかしながらどう書いてよいか全く分かりません。

該当のソースコード

（日付・行先の出力部分のみ）

Sub sample()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim i As Long
Dim j As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
i = 1

'日付・行先をすべて書き出した後重複を削除
With ws2
    For j = 2 To ws1.Cells(Rows.Count, 1).End(xlUp).Row
        .Cells(i, 11) = ws1.Cells(j, 1)
        .Cells(i, 12) = ws1.Cells(j, 4)
        i = i + 1
    Next
    .Columns("K:L").RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo
End With

End Sub

試したこと

マクロのみでは実現できなかったため現状下記の通り関数と組み合わせてなんとか使用しております。
しかしながら可能でしたらマクロのみで一気に表を完成させられればそれに越したことはないので詳しい方アドバイスいただけますと幸いです。

1. マクロでSheet2のK列とL列に日付と行先を出力後、重複を削除
2. 1の結果をB1:I2に"="で出力
3. Sheet1, 2ともに表の外に「日付+行先+商品名」を結合したものを作る
4. 3を使いINDEXとMATCH関数で値を出力

補足情報（FW/ツールのバージョンなど）

OS: Windows10
EXCEL: Office365

Answer 1

ピボットテーブルでほぼ同様のことが簡単にできますが、どうしてもVBAで実装しなければならないのでしょうか。

Comments

[nekozombie]

hope_mucci様
ご回答ありがとうございます。
なるほど。確かにピボットテーブルを使った方がスマートですね。
ただ今回は顧客からフォームをあまり変えないでほしいと言われておりますためVBAでの実現を考えておりました。
アドバイスありがとうございました。

[hope_mucci]

ピボットテーブルに対しても書式は変えられます。ピボットテーブルオプションで表示方法や内容を細かく変更することができます。オプションと書式設定で想定とほぼほぼ同じフォーマットの表にすることも可能です。完全一致とまではいけませんが。
また、ピボットテーブルをデータシートとし、書式体裁を整えたシートを別シートに用意して値だけ転記することも可能でしょう。

顧客要望で「あまりフォームを変えてほしくない」というのは「良くなるのであればフォームを変えても良い」ということでしょう。より良いものができるのであれば、開発側から逆に提案するのも一つだと思います。ケースバイケースの部分もありますが顧客満足度につながります。
最終的にVBAで実装するとは思いますが、テクニックに対する引出しという点でも「実は標準機能でできる」というやり方を知っておくのは損ではないと思います。
コスト削減にもつながりますし、バグの心配もありません。

[nekozombie]

おっしゃる通り標準機能であればバグの心配もいらないですし最初に考えるべき選択肢かもしれませんね。
ところで普段あまり使わないこともありピボットテーブルについてそれほど細かく書式を変えられることを存じ上げておりませんでした。少し基本に戻って勉強したいと思います。
どうもありがとうございました！

Answer 2

たとえばこんな感じでどうでしょう。

Sub sample()
    Dim rdic As Scripting.Dictionary
    Set rdic = CreateObject("Scripting.Dictionary")
    Dim cdic As Scripting.Dictionary
    Set cdic = CreateObject("Scripting.Dictionary")
    
    With Sheet1.UsedRange
        Dim i
        For i = 2 To .Rows.Count
            Dim r, c
            r = .Cells(i, 2).Text
            c = Join(Array(.Cells(i, 1).Text, .Cells(i, 4).Text))
            
            If Not rdic.Exists(r) Then
                rdic(r) = rdic.Count + 3
                Sheet2.Cells(rdic(r), 1).Value = r
            End If
            If Not cdic.Exists(c) Then
                cdic(c) = cdic.Count + 2
                Sheet2.Cells(1, cdic(c)).Resize(2).Value = WorksheetFunction.Transpose(Split(c))
            End If
            Sheet2.Cells(rdic(r), cdic(c)).Value = .Cells(i, 3).Value
        Next
        
        Dim cell As Range
        For Each cell In Sheet2.Cells.Resize(rdic.Count, cdic.Count).Offset(2, 1)
            If IsEmpty(cell) Then cell.Value = 0
        Next

    
    End With
    
    With Sheet2.Rows(rdic.Count + 3)
        .Cells(1, 1).Value = "合計"
        .Resize(, cdic.Count).Offset(, 1).FormulaR1C1 = "=SUM(R[-" & rdic.Count & "]C:R[-1]C)"
    End With

    Sheet2.UsedRange.Borders.LineStyle = 1


End Sub

Comments

[nekozombie]

jinoji様
ご回答ありがとうございます。
見事の一言です。一発で表ができました！
これは連想配列というものでしょうか？今の私には高度過ぎて理解が追い付いておりませんが頑張って習得したいと思います。

ところで度重なる質問で恐縮ですが20行目の
Sheet2.Cells(1, cdic(c)).Resize(2).Value = WorksheetFunction.Transpose(Split(c))
がよくわからないのですが簡単にご説明いただけますと助かります。
（transpose関数は列と行を入れ替える関数とだけ理解しております）

どうぞよろしくお願いいたします。

[jinoji]

普通の配列が0,1,2…の数字がインデックスになるのに対して、
連想配列は、文字列をインデックスに使います。
今回は、「納品日+納品先」ごとに列番号を保持したかったので、
その2つをブランクで結合したものをcに代入し、それを連想配列のキーにしました。
一方、シートに出力するときには縦に2セルの形にしたいので、
先ほどブランクで結合したものを逆にsplitで分割して普通の配列にします。
ただ、そのままセルに出力すると横向きの2セルになるので、
transposeで列と行を入れ替えました。

[nekozombie]

なるほど。縦に2つ並べるためだったんですね。
とても分かりやすい説明で勉強になります。
どうもありがとうございました！