|
看看对不对吧
Sub sdsds()
Dim dic As Object, arr, brr()
Set dic = CreateObject("scripting.dictionary")
With Sheet1
arr = .[a1].CurrentRegion.Value
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 2 To UBound(arr)
If dic.exists(arr(i, 1)) = False Then Set dic(arr(i, 1)) = CreateObject("scripting.dictionary")
If dic(arr(i, 1))(arr(i, 2)) = "" Then
dic(arr(i, 1))(arr(i, 2)) = arr(i, 3)
Else
dic(arr(i, 1))(arr(i, 2)) = dic(arr(i, 1))(arr(i, 2)) & "/" & arr(i, 3)
End If
Next i
k = dic.keys
For i = 0 To UBound(k)
brr(i + 1, 1) = k(i)
items = dic(k(i)).items()
For m = 0 To UBound(items)
If m = 0 Then
brr(i + 1, 3) = items(m)
Else
brr(i + 1, 3) = brr(i + 1, 3) & "/" & items(m)
End If
Next m
m = dic(k(i)).keys
For j = 0 To UBound(m)
If brr(i + 1, 2) = "" Then
brr(i + 1, 2) = m(j)
Else
brr(i + 1, 2) = brr(i + 1, 2) & "/" & m(j)
End If
Next j
Next i
.Range("e9").Resize(UBound(brr), 3) = brr
End With
End Sub
|
评分
-
1
查看全部评分
-
|