excel吧 关注：280,932贴子：1,544,331
- 34回复贴，共1页
Sub 问题()
Dim dic, row, arr, drr, brr, r, b, d
Set dic = CreateObject("scripting.dictionary")
row = Cells(Rows.Count, 1).End(xlUp).row
ReDim drr(1 To row, 1 To 2)
arr = [a1].CurrentRegion
For r = 2 To row
If Not dic.exists(Cells(r, 1).Value) Then
num = num + 1
drr(num, 1) = Cells(r, 1).Value
End If
dic(Cells(r, 1).Value) = dic(Cells(r, 1).Value) & "," & r
Next
[f2].Resize(num, 1) = drr
drr = []
For r = 2 To num + 1
drr = Split(dic(Cells(r, 6).Value), ",")
ReDim brr(1 To UBound(drr, 1))
For d = 1 To UBound(drr, 1)
brr(d) = arr(drr(d), 2)
Next
Cells(r, 7).Value = Join(brr, " ")
Next
End Sub
这个可以嘛
Sub 字典结合数组初级用法()
Dim d As Object
Dim i, k, g, arr
Set d = CreateObject("scripting.dictionary")
arr = Sheet13.UsedRange
For i = 2 To UBound(arr, 1)
g = arr(i, 1)
If g = "" Then GoTo line
If d.exists(g) Then
k = d(g)
k(1) = k(1) & " " & arr(i, 2)
Else
k = Array(arr(i, 1), arr(i, 2))
End If
d(g) = k
line:
Next i
[d2].Resize(d.Count, 2) = Application.Rept(d.items, 1)
End Sub
骨娄
