テスト41

```vb

Public dic3 As Variant
'-------------------------------------------
Sub Main()

Dim i As Long
i = 2

With ThisWorkbook.Sheets("一覧表2")

    Do Until .Cells(i, 1).Value = ""
    
        .Cells(i, 4).Value = .Cells(i, 2).Value & "@" & .Cells(i, 3).Value
        
        i = i + 1
        
    Loop

End With


Call dic2

Call Pivot_Process

Call Agg_Process

End Sub

'-------------------------------------------

Sub dic2()

Dim dic As Variant
Dim i As Long
Dim j As Long
Dim Last_Row As Long

Set dic = CreateObject("Scripting.Dictionary")

With ThisWorkbook.Sheets("一覧表2")

    Last_Row = .Cells(.Rows.Count, 1).End(xlUp).Row
    
    For j = 2 To Last_Row
    
        If dic.Exists(StrConv(Trim(.Cells(j, 2).Value), vbNarrow)) = False Then
    
            dic.Add StrConv(Trim(.Cells(j, 2).Value), vbNarrow), CStr(j)
    
        End If
    
    Next j

End With


With ThisWorkbook.Sheets("集計表")
    '表内の値と罫線を全て削除
    .Cells.ClearContents
    .Cells.ClearFormats
    
    '項目を入力
    .Range("A1:C1") = Array("商品コード", "1", "2")

    For i = 0 To dic.Count - 1

        .Cells(i + 2, 1).Value = dic.keys()(i)
        
    Next i
    
    .Cells(i + 2, 1).Value = "合計"
    .Cells(i + 2, 1).HorizontalAlignment = xlCenter
    .Rows(1).HorizontalAlignment = xlCenter
    
    Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous

End With
 
End Sub

'-------------------------------------------

Sub Pivot_Process()

Dim i As Long

Set dic3 = CreateObject("Scripting.Dictionary")
i = 4

With ThisWorkbook.Sheets("ピボット")
    'ピボットテーブルの更新
    .PivotTables("ピボットテーブル1").PivotCache.Refresh
    
    Do Until .Cells(i, 1).Value = "総計"
    
        .Cells(i, 3).Value = .Cells(i, 1).Value & "@" & .Cells(i, 2).Value
        
        dic3.Add .Cells(i, 3).Value, CStr(i - 2)
        
        i = i + 1
        
    Loop

End With

End Sub

'-------------------------------------------

Sub Agg_Process()

Dim myRange As Variant
Dim myRange2 As Variant
Dim myArray As Variant
Dim Last_Row As Long
Dim i As Long

i = 4
    
With ThisWorkbook.Sheets("ピボット")

    '最終行取得
    Last_Row = ThisWorkbook.Sheets("集計表").Cells(.Rows.Count, 1).End(xlUp).Row
    
    '検索範囲
    Set myRange = ThisWorkbook.Sheets("集計表").Range("A2:A" & Last_Row)
    
    Do Until .Cells(i, 1).Value = "総計"
    
        myArray = Split(dic3.keys()(i - 4), "@")
    
        Set myRange2 = myRange.Find(What:=myArray(0), LookAt:=xlWhole, SearchOrder:=xlByRows)
    
        If Not myRange2 Is Nothing Then
        
            If Left(myArray(1), 1) = 1 Then
            
                ThisWorkbook.Sheets("集計表").Cells(myRange2.Row, 2).Value = myArray(2)
            
            ElseIf Left(myArray(1), 1) = 2 Then
            
                ThisWorkbook.Sheets("集計表").Cells(myRange2.Row, 3).Value = myArray(2)
            
            End If
        
        Else
        
        End If
        
        Erase myArray
        
        i = i + 1

    Loop
    
End With
 

i = 2

With ThisWorkbook.Sheets("集計表")

    Do Until .Cells(i, 1).Value = "合計"
        '空欄の箇所に0を入れていく
        If .Cells(i, 2).Value = "" Then
        
            .Cells(i, 2).Value = 0
        
        ElseIf .Cells(i, 3).Value = "" Then
        
            .Cells(i, 3).Value = 0
        
        End If
        
        i = i + 1
    
    Loop
    
    .Cells(Last_Row, 2).Value = WorksheetFunction.Sum(.Range("B2", "B" & Last_Row - 1))
    .Cells(Last_Row, 3).Value = WorksheetFunction.Sum(.Range("C2", "C" & Last_Row - 1))
    
End With


End Sub