Sub 模糊查找()
ar = Sheets("Sheet1").[a1].CurrentRegion
With Sheets("sheet2")
r = .Cells(Rows.Count, 1).End(xlUp).Row
br = .Range("a1:a" & r)
ReDim arr(1 To UBound(ar), 1 To 3)
For i = 2 To UBound(br)
If br(i, 1) <> "" Then
sl = Len(Trim(br(i, 1)))
For s = 2 To UBound(ar)
If ar(s, 1) <> "" Then
If InStr(ar(s, 1), br(i, 1)) > 0 Then
wz = InStr(ar(s, 1), br(i, 1))
n = n + 1
arr(n, 1) = Left(ar(s, 1), wz - 1)
arr(n, 2) = br(i, 1)
arr(n, 3) = Right(ar(s, 1), Len(Trim(ar(s, 1))) - sl - wz + 1)
End If
End If
Next s
End If
Next i
.[c1].CurrentRegion.Offset(1) = Empty
.[c2].Resize(n, 3) = arr
End With
MsgBox "ok!"
End Sub
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-1-5 09:21
