再粘一次,度娘删回复。。 Sub 秋天() Dim rng As Range, a$, arr(1 To 100), n% Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "[一-龥]+" For Each rng In Range("a2", [a2].End(4)) For Each m In .Execute(rng) rg = Replace(rng(1, 2), m, "") If Len(m) = Len(rng(1, 2)) - Len(rg) And Len(m) > 1 Then a = a & " " & m End If Next n = n + 1 arr(n) = a a = "" Next End With [c2].Resize(n) = Application.Transpose(arr) End Sub
2L删的回复当时也没问题,依然是不能有张仙和张仙女这样的比对即可。 Sub 秋天() Dim rng As Range, rg As Range, a$, arr(1 To 100), n% Set regx = CreateObject("vbscript.regexp") With regx .Global = True .Pattern = "[一-龥]+" For Each rng In Range("a2", [a2].End(4)) For Each m In .Execute(rng) Set rg = rng(1, 2).Find(m) If Not rg Is Nothing Then a = a & " " & m End If Next n = n + 1 arr(n) = a a = "" Next End With [c2].Resize(n) = Application.Transpose(arr) End Sub