|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub ttt()
Dim arr(), nrow&, rng As Range
Dim dic As Object, dic2 As Object
Set dic = CreateObject("Scripting.Dictionary")
With Sheet1
nrow = .Range("b1048576").End(xlUp).Row
arr = .Range("b2:d" & nrow).Value
End With
For i = 1 To UBound(arr)
If dic(arr(i, 3)) = "" Then
dic(arr(i, 3)) = arr(i, 1)
Else
dic(arr(i, 3)) = dic(arr(i, 3)) + "、" + arr(i, 1)
End If
Next i
[f2].Resize(dic.Count) = Application.Transpose(dic.keys)
[g2].Resize(dic.Count) = Application.Transpose(dic.items)
End Sub
|
|