vba Excel - 查找“看起来像”的值
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/15928469/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel - finding values that "look like"
提问by EmilNygaard
I have an excel workbook with a ton of sheets. In the first sheet "users" i have userdata, firstname, lastname, email, etc. all neatly split from a CSV file. In the other sheets, i have some of the names and need the emails from the "users" sheet.
我有一个包含大量工作表的 excel 工作簿。在第一张“用户”表中，我有用户数据、名字、姓氏、电子邮件等。所有这些都从 CSV 文件中整齐地拆分出来。在其他工作表中，我有一些姓名，需要来自“用户”工作表的电子邮件。
The problem is, that the names on all the other sheets are all in one cell with both first- and lastname like, and in the users-sheet it's split. Also, in the other sheets it might be written as "Mike Anderson", "Mike, Anderson" or even "Anderson, Mike".
问题是，所有其他工作表上的名称都在一个单元格中，名字和姓氏都一样，而在用户工作表中它被拆分了。此外，在其他工作表中，可能会写成“Mike Anderson”、“Mike, Anderson”甚至“Anderson, Mike”。
Does anyone have an idea to a macro / VBA script / formular, that would help me find and copy the corresponding emails?
有没有人对宏/VBA 脚本/公式有想法，可以帮助我找到并复制相应的电子邮件？
回答by Siddharth Rout
To check for Mike Anderson, Mike, Andersonor even Anderson, Mike, you can use .Findand .FindNext.
要检查Mike Anderson，Mike, Anderson甚至Anderson, Mike，你可以使用.Find和.FindNext。
See this example
看这个例子
Logic: Use the Excel's inbuilt .Findmethod to find Mikeand once that is found, simply check if the cell also has Anderson
逻辑：使用 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
Screenshot
截屏
More on .Findand .Findnexthere.
更多.Find和.Findnext这里。
回答by Our Man in Bananas
you can use the VBA LIKEoperator with wildcards perhaps?
您可以使用带有通配符的 VBA LIKE运算符吗？
If activecell.text LIKE "*Paul*" then ...
and also, as Florishas pointed out, you would need Option Compare Textset at the top of the module to ensure your test isn't case-sensitive
而且，正如Floris指出的那样，您需要Option Compare Text在模块顶部设置以确保您的测试不区分大小写
回答by kadrleyn
The searched value can be easily found in all the workbook with the textbox and option buttons that they are added to the workbook's first sheet .
搜索值可以很容易地在所有工作簿中找到，文本框和选项按钮将它们添加到工作簿的第一个工作表中。
Through option buttons,value in textbox can be searched as two types , whole or part :
通过选项按钮，文本框中的值可以搜索为两种类型，整体或部分：
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
I too have used Find & FindNext Methodin template coding :
我也在模板编码中使用了Find & 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
All results are listed as hyperlinks in the generated report sheet with different a function.
所有结果都在生成的报告表中以超链接的形式列出，具有不同的功能。
