|
好了,
- Sub 按钮4_Click()
- Dim a, b(), c&, da, db
- Set da = CreateObject("Scripting.Dictionary")
- a = Range("A1").CurrentRegion
- For i = 2 To UBound(a)
- If Not da.exists(a(i, 2)) Then
- da.Add a(i, 2), a(i, 5)
- ElseIf da.exists(a(i, 2)) Then
- da(a(i, 2)) = da(a(i, 2)) & "," & a(i, 5)
- End If
- Next i
- For j = 0 To UBound(da.items())
- Dim str
- str = Split(da.items()(j), ",")
- Set db = CreateObject("Scripting.Dictionary")
- If c = 0 Then
- c = UBound(str)
- Else
- c = WorksheetFunction.Max(c, UBound(str))
- End If
- ReDim Preserve b(0 To UBound(da.items()), 0 To c)
- b(j, 0) = da.keys()(j)
- Dim ii&
- ii = 1
- For k = 0 To UBound(str)
- If Not db.exists(str(k)) And str(k) <> "" Then
- db.Add str(k), ""
- b(j, ii) = str(k)
- ii = ii + 1
- End If
- Next k
- str = ""
- Set db = Nothing
- Next j
- Range("P1").Resize(UBound(b), UBound(b, 2)) = b
- End Sub
复制代码 |
|