只有一个名字的情况下如何匹配对应的完整内容

月夜漫步

3190496160

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

3190496160

3190496160

222.rar (11.69 KB, 下载次数: 2)

2024-1-5 09:56 上传

点击文件名下载附件