'词长优先简单匹配
Option Explicit
Const NUM As Long = 4 '至少长度为4的字符串匹配,自己调整
Sub abc()
Dim a, i, j, k, t, n, s(1)
a = [a1].CurrentRegion.Offset(1).Resize(, 2).Value
ReDim b(1 To UBound(a) - 1, 1 To 1) As String
For i = 1 To UBound(a) - 1
If Len(a(i, 1)) <= Len(a(i, 2)) Then
n = Len(a(i, 1))
s(0) = a(i, 1): s(1) = a(i, 2)
Else
n = Len(a(i, 2))
s(0) = a(i, 2): s(1) = a(i, 1)
End If
For j = n To NUM Step -1
For k = 1 To Len(s(0)) - j + 1
t = Mid(s(0), k, j)
If InStr(s(1), t) Then
b(i, 1) = t
j = NUM: Exit For
End If
Next
Next
Next
[d2].Resize(UBound(b)) = b
End Sub