Sub 資料彙整()
Dim d, arr
Dim i As Long
Set d = CreateObject("scripting.dictionary")
arr = Range("a3:c17908")
For i = 2 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
d(arr(i, 1)) = arr(i, 2)
'如果Arr(i,1)不存在的話,那麼就將Arr(i,2)的值賦予給Arr(i,1)關鍵字
Else
d(arr(i, 1)) = d(arr(i, 1)) & "、" & arr(i, 2)