Excel VBA 連想配列 1つのKey に対して2つ以上 Item を追加する

前回記事の続き

いろいろ調べて見つけたいちばん楽そうな書き方

シートの構成

実行前の状態です。

コード

Enum を使用して、列番号がマジックナンバーになることを回避しています。

Option Explicit

Enum category
  enName = 1
  enScore = 2
  enPower = 3
End Enum

Sub test()
  
  Dim dic As New Dictionary
  Dim i As Long
  
  Dim shData As Worksheet: Set shData = ThisWorkbook.Sheets("データベース")
  Dim shSum As Worksheet: Set shSum = ThisWorkbook.Sheets("集計")
  
  For i = 2 To shData.Cells(Rows.Count, 1).End(xlUp).row
  
    Dim dickey As String
    dickey = shData.Cells(i, enName).Value
    
    If dic.Exists(dickey) Then
    
      Dim score As Long
      Dim power As Long
      
      score = dic(dickey)(0) + shData.Cells(i, enScore)
      power = dic(dickey)(1) + shData.Cells(i, enPower)
      
      dic(dickey) = Array(score, power)
      
    Else
    
      dic.Add dickey, Array(shData.Cells(i, enScore), shData.Cells(i, enPower))
    
    End If
    
  Next i
  
  i = 2
  
  Dim buf As Variant
  
  For Each buf In dic.keys
  
    shSum.Cells(i, enName).Value = buf
    shSum.Cells(i, enScore).Value = dic(buf)(0)
    shSum.Cells(i, enPower).Value = dic(buf)(1)
    
    i = i + 1

  Next buf
      
End Sub

Enum について

A列(1)をenName、B列(2)をenScore、C列(3)をenPower としています。

Enum category
  enName = 1
  enScore = 2
  enPower = 3
End Enum

値を省略する書き方

Enum category
  enName = 1
  enScore
  enPower
End Enum

実行後

参考文献