以字为单位写的:
Sub test()
Dim ar1(), ar2()
s$ = [d1].Value
ar1 = [f1:f24].Value
ReDim ar2(1 To UBound(ar1), 1 To 1)
For Each stmp In ar1
stmp2$ = Replace(stmp, " ", "")
t% = 1
Do While Len(stmp2)
If InStr(s, Left(stmp2, 1)) < 1 Then
t = 0
stmp2 = ""
Else
stmp2 = Replace(stmp2, Left(stmp2, 1), "")
End If
Loop
If t Then
r = r% + 1
ar2(r, 1) = stmp
End If
Next
If r Then [l1].Resize(r, 1) = ar2
End Sub