1

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

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

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

4

3 回答 3

7

要检查Mike Anderson，Mike, Anderson甚至Anderson, Mike，您可以使用.Findand .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 。

于 2013-04-10T14:35:59.877 回答
2

您可以将 VBA LIKE运算符与通配符一起使用吗？

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

而且，正如Floris指出的那样，您需要Option Compare Text在模块顶部设置以确保您的测试不区分大小写

于 2013-04-10T14:26:41.250 回答
0

搜索值可以很容易地在所有工作簿中找到，文本框和选项按钮被添加到工作簿的第一个工作表中。

在此处输入图像描述

通过选项按钮，可以将文本框中的值搜索为整体或部分两种类型：

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 & 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

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

于 2016-07-29T14:56:18.420 回答