Excel - finding values that “look like”

问题

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.

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".

Does anyone have an idea to a macro / VBA script / formular, that would help me find and copy the corresponding emails?

回答1:

To check for Mike Anderson, Mike, Anderson or even Anderson, Mike, you can use .Find and .FindNext .

See this example

Logic: Use the Excel's inbuilt .Find method to find Mike and once that is found, simply check if the cell also has 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

回答2:

you can use the VBA LIKE operator with wildcards perhaps?

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

and also, as Floris has pointed out, you would need Option Compare Text set at the top of the module to ensure your test isn't case-sensitive

回答3:

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 .

enter image description here

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 Method in template coding :

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.

来源：https://stackoverflow.com/questions/15928469/excel-finding-values-that-look-like

标签

excel

vba

excel-vba

excel-formula