
'如果行数多可以用这方法。
Option Explicit
Sub abc()
Dim a, i, j, t, d(2)
a = [a1].CurrentRegion.Resize(, 2).Value
For i = 1 To 2
Set d(i) = CreateObject("scripting.dictionary")
Next
For i = 1 To UBound(a)
t = Split(Trim(a(i, 1)))
If UBound(t) > 0 Then
For j = 0 To UBound(t)
d(1)(Mid(t(j), 2)) = 1
d(2)(Left(t(j), Len(t(j)) - 1)) = 1
Next
For j = 1 To 2
a(i, j) = Join(d(j).keys)
d(j).RemoveAll
Next
Else
a(i, 2) = Left(a(i, 1), Len(a(i, 1)) - 1)
a(i, 1) = Mid(a(i, 1), 2)
End If
Next
With [B1].Resize(UBound(a), 2)
.NumberFormatLocal = "@"
.Value = a
End With
End Sub