vba - Excel - 查找 "look like"的值

Question

我有一个带有大量工作表的 Excel 工作簿。在第一张“用户”表中，我将用户数据、名字、姓氏、电子邮件等全部从 CSV 文件中整齐地拆分出来。
在其他表格中，我有一些姓名，需要来自“用户”表格的电子邮件。

问题是，所有其他工作表上的名字都在一个单元格中，名字和姓氏都像，并且在用户工作表中它被拆分了。此外，在其他表中，它可能写成“Mike Anderson”、“Mike, Anderson”甚至“Anderson, Mike”。

有没有人对宏/VBA脚本/公式有想法，可以帮助我找到并复制相应的电子邮件？

Answer 1

检查 Mike Anderson , Mike, Anderson甚至Anderson, Mike , 你可以使用 .Find和 .FindNext .

看这个例子

逻辑 : 使用 Excel 的内置 .Find查找方法Mike一旦找到，只需检查单元格是否也有Anderson

Sub Sample()
    Dim oRange As Range, aCell As Range, bCell As Range
    Dim ws As Worksheet
    Dim SearchString As String, FoundAt As String

    On Error GoTo Err

    Set ws = Worksheets("Sheet1")
    Set oRange = ws.Columns(1)

    SearchString = "Mike"

    Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Set bCell = aCell

        If InStr(1, aCell.Value, "Anderson", vbTextCompare) Then _
        FoundAt = aCell.Address

        Do
            Set aCell = oRange.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                If InStr(1, aCell.Value, "Anderson", vbTextCompare) Then _
                FoundAt = FoundAt & ", " & aCell.Address
            Else
                Exit Do
            End If
        Loop
    Else
        MsgBox SearchString & " not Found"
        Exit Sub
    End If

    MsgBox "The Search String has been found these locations: " & FoundAt
    Exit Sub
Err:
    MsgBox Err.Description
End Sub

截图



更多关于 .Find和 .Findnext here .