Excel - 查找“看起来像”的值

Question

我有一张带有大量床单的Excel工作簿。在第一张“用户”中，我有userdata，firstname，lastname，email等，它们都是从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和{{1}} here的更多信息。

Answer 2

你可以使用带有通配符的VBA LIKE 运算符吗？

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

并且正如 Floris 指出的那样，您需要在模块顶部设置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

我也使用了 Find＆amp;模板编码中的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

所有结果都在生成的报告表中以超链接的形式列出，具有不同的功能。