参与一下。。。
- Sub ykcbf() '//2024.6.24
- Application.ScreenUpdating = False
- Set d = CreateObject("Scripting.Dictionary")
- r = Cells(Rows.Count, "a").End(3).Row
- arr = [a2].Resize(r - 1, 2)
- sort2 arr, 1, 1
- For i = 1 To UBound(arr)
- s = Left(arr(i, 1), 10)
- s2 = Mid(arr(i, 1), 11)
- If Not d.exists(s) Then
- d(s) = s2
- Else
- d(s) = IIf(InStr(d(s), s2), d(s), d(s) & "," & s2)
- End If
- Next
- For i = 1 To UBound(arr)
- s = Left(arr(i, 1), 10)
- s2 = Mid(arr(i, 1), 11)
- If d.exists(s) Then
- Cells(i + 1, 2) = d(s)
- End If
- Next
- Set d = Nothing
- Application.ScreenUpdating = True
- MsgBox "OK!"
- End Sub
复制代码
|