哟哟哟。

这些人什么想法，发帖求助然后限制评论，绝了

最近由于网络暴力太严重，贴吧频繁地出现了这种禁止回复的帖子，真是让人无语啊。每当看到这种帖子，我忍不住想回复他一串问号。

'凑了一个，应该会有2种或更多结果的，条件不是很明确
Option Explicit
Sub abc()
　Dim a, i, j, t, key, m, d
　a = [a1].CurrentRegion.Resize(, 1).Value
　Set d = CreateObject("scripting.dictionary")
　Call bsort(a, 1, UBound(a), 1, 1, 1)
　For i = 1 To UBound(a)
　　If d.exists(a(i, 1)) Then
　　　d(a(i, 1)) = d(a(i, 1)) & Space(1) & a(i, 1)
　　Else
　　　t = right(a(i, 1), 1) & left(a(i, 1), 1)
　　　If d.exists(t) Then
　　　　d(t) = d(t) & Space(1) & a(i, 1)
　　　Else
　　　　d(a(i, 1)) = d(a(i, 1)) & Space(1) & a(i, 1)
　　　End If
　　End If
　Next
　For Each key In d.keys
　　t = Split(d(key))
　　For i = 1 To UBound(t)
　　　m = m + 1: a(m, 1) = t(i)
　　Next
　Next
　[c1].Resize(UBound(a)) = a
End Sub
Function bsort(a, first, last, left, right, key)
　Dim i, j, k, t
　For i = first To last - 1
　　For j = first To last + first - 1 - i
　　　If StrComp(a(j, key), a(j + 1, key), vbTextCompare) = 1 Then
　　　　For k = left To right
　　　　　t = a(j, k): a(j, k) = a(j + 1, k): a(j + 1, k) = t
　　　　Next
　　　End If
　　Next
　Next
End Function