Excel - 查找「看起來像」的值

Question

我有一張excel工作簿，有很多工作表。在第一張「用戶」表中，我將用戶數據，名字，姓氏，電子郵件等全部整齊地從CSV文件中分離出來。 在其他表中，我有一些名字，需要來自「用戶」表的電子郵件。

問題是，所有其他工作表上的名稱都在一個單元格中，名稱和姓氏都一樣，並且在用戶表中被拆分。此外，在其他表格中，它可能被寫爲「邁克安德森」，「邁克，安德森」，甚至「安德森邁克」。

有沒有人有一個想法宏/ 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和.Findnexthere。

Answer 2

你可以使用VBA LIKE運算符可能帶有通配符？

If activecell.text LIKE "*Paul*" then ... 

而且，作爲弗洛里斯指出的那樣，你將需要Option Compare Text設定在模塊的頂部，以確保您的測試是不是區分大小寫

Answer 3

通過將文本框和選項按鈕添加到工作簿的第一張工作表中，可以在所有工作簿中輕鬆找到搜索值。

enter image description here

通過選項按鈕，在文本框的值可以被搜索兩種類型，全部或部分：

If Sheets(1).OptionButton1 = True Then 
Set Firstcell = Cells.Find(What:=Sheets(1).TxtSearch, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 
Else 
Set Firstcell = Cells.Find(What:=Sheets(1).TxtSearch, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) 
End If 

我也已經使用查找& FindNext方法模板編碼：

If Not Firstcell Is Nothing Then 
Firstcell.Activate 
Firstcell.Interior.ColorIndex = 19 

With Sheets("New_Report").Range("A1") 
.Value = "Addresses Of The Found Results" 
.Interior.ColorIndex = 19 
End With 
Sheets("New_Report").Range("A:A").EntireColumn.AutoFit 
Sheets("New_Report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = oSheet.Name & "!" & Firstcell.Address(False, False) 

Call Create_Hyperlinks 'Hyperlinks are generated in New Report Sheet 

If MsgBox("Found " & Chr(34) & Sheets(1).TxtSearch & Chr(34) & " in " & oSheet.Name & "!" & Firstcell.Address & vbLf & "Do You Want To Continue?", vbExclamation + vbYesNo) = vbNo Then 
Exit Sub: End If 

While (Not NextCell Is Nothing) And (Not NextCell.Address = Firstcell.Address) 
        counter = counter + 1 
Firstcell.Interior.ColorIndex = xlNone 
Set NextCell = Cells.FindNext(After:=ActiveCell) 

If NextCell.Row = 2 Then 
Set NextCell = Range(Cells(3, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, LastColumn)).FindNext(After:=ActiveCell) 
End If 

If Not NextCell.Address = Firstcell.Address Then 
NextCell.Activate 
NextCell.Interior.ColorIndex = 19 
Sheets("New_Report").Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = oSheet.Name & "!" & NextCell.Address(False, False) 

Call Create_Hyperlinks 

If MsgBox("Found " & Chr(34) & Sheets(1).TxtSearch & Chr(34) & " in " & oSheet.Name & "!" & NextCell.Address & vbLf & "Do You Want To Continue?", vbExclamation + vbYesNo) = vbNo Then 
Exit Sub: End If 

End If 'If Not NextCell.Address = Firstcell.Address Then 
NextCell.Interior.ColorIndex = xlNone 

Wend 
End If 
Next oSheet 
End If 

所有結果在生成的報告中列爲超鏈接t表具有不同的功能。