Vba EXCEL-检查/识别多行之间和其他工作表上的重复文本

我有20世纪初纽约罪犯的名字和姓氏。我已经缩小了我关注的特定犯罪领域，但我想将这些名字与更广泛的数据库进行交叉引用，看看他们是否犯过任何其他罪行。问题是，名字和姓氏在不同的单元格中。因此，到目前为止，我所能做的最好的事情就是在姓氏匹配的情况下标记一个“X”，在名字匹配的情况下在旁边的列中标记一个“X”。问题是，虽然它稍微缩小了范围，但有很多人的名字是“亚当”，还有很多人的姓氏是“布朗”，所以它并不表明实际上存在匹配

因此，电子表格1“S1”在C2中有一个姓（例如布朗），在D2中有一个名（例如约翰），而电子表格2“S2”在C2和D2中有完全不同的名字，因此我需要搜索C和D的所有列以查找匹配项

---

有没有一种编写代码的方法？有什么想法吗

如果自定义报告更方便，下面的VBA代码需要额外的工作表

假设您的工作表是“Sheet1”（S1）、“Sheet2”（S2）和Sheet3（报告），则解决方案将在Sheet3上生成一个列表，其中包含S1中与S2匹配的所有唯一名字+姓氏

• B列将显示S1中存在多少重复项
• C列=名字（S1）
• D列=姓氏（S1）
• 列E将显示S2中存在多少重复项

其他功能：

如果您单击S3上的任何名称（第一个或最后一个），它将过滤S1和S2中的该名称，如下所示：

---

S1

S2

---

报告（S3）

---

单击S3中的“First3”（或“Last3”），您将获得

S1

S2

---

守则：

打开VBA编辑器：Alt+F11

• 插入新的通用模块：在左上窗格的任意位置单击鼠标右键，然后选择“插入->模块”
• 在新模块（可能称为Module1）的右侧窗格中，粘贴以下代码：

---

模块1（共4个程序）：

---

---

---

---

现在，在VBA编辑器中双击项目“Sheet3”（左上角），打开其模块并粘贴此代码

---

“Sheet3”模块（1程序）：

---

选项显式
专用子工作表\u选择更改（ByVal目标作为范围）
如果Target.CountLarge=1，则
尺寸lr为长，fn为字符串，ln为字符串
lr=Me.UsedRange.Rows.Count
有目标
如果（.Row>1和.Row为什么不将变量设为first name+last name，然后进行任何匹配？您可以使用两列匹配：或者您可以使用vLOOKUPDo您知道VBA，或者您正在寻找公式式答案？
Option Explicit

Public Sub FindMatches()
    Dim ws1 As Worksheet, ws2 As Worksheet, d1 As Object, d2 As Object

    Set ws1 = Sheet1
    Set ws2 = Sheet2
    Set d1 = ReadNames(ws1)
    Set d2 = ReadNames(ws2)

    If Not d1 Is Nothing And Not d2 Is Nothing Then MatchNames d1, d2
    Sheet3.Activate
End Sub

Private Function ReadNames(ByRef ws As Worksheet) As Object
    If Not ws Is Nothing Then
        Dim d As Object, ur As Variant, i As Long

        Set d = CreateObject("Scripting.Dictionary")
        d.CompareMode = TextCompare

        ur = ws.UsedRange.Columns("C:D") 'Read all names
        For i = LBound(ur) To UBound(ur)
            If Not d.Exists(ur(i, 1) & " " & ur(i, 2)) Then 'this keeps count of dupes
                d(ur(i, 1) & " " & ur(i, 2)) = 1
            Else
                d(ur(i, 1) & " " & ur(i, 2)) = d(ur(i, 1) & " " & ur(i, 2)) + 1
            End If
        Next
        Set ReadNames = d
    End If
End Function

'Generates list of unique names on Sheet3, for full names from Sheet1, found on Sheet2

Private Sub MatchNames(ByRef d1 As Object, d2 As Object)
    If Not d1 Is Nothing And Not d2 Is Nothing Then
        Dim ur As Variant, itm As Variant, i As Long, fl As Variant

        With Sheet3     'Or use Worksheets("Sheet3") 'or "Matches", or "Report", etc
            .UsedRange.EntireRow.Delete
            ur = .Range(.Cells(1, 2), .Cells(d1.Count, 5))
        End With
        ur(1, 1) = "Sheet1 Count":  ur(1, 4) = "Sheet2 Count"
        ur(1, 2) = "First Name":    ur(1, 3) = "Last Name"
        i = 2
        For Each itm In d1
            If d2.Exists(itm) Then
                ur(i, 1) = d1(itm)
                fl = Split(itm)
                ur(i, 2) = fl(0)
                ur(i, 3) = fl(1)
                ur(i, 4) = d2(itm)
                i = i + 1
            End If
        Next
        With Sheet3
            .Range(.Cells(1, 2), .Cells(d1.Count, 5)) = ur
            With .UsedRange.Columns
                .EntireColumn.AutoFit
                .HorizontalAlignment = xlCenter
            End With
        End With
    End If
End Sub

Public Sub FilterNames(ByRef ws As Worksheet, ByVal fName As String, lName As String)
    With ws.UsedRange
        .AutoFilter Field:=4, Criteria1:=lName
        .AutoFilter Field:=3, Criteria1:=fName
    End With
End Sub

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.CountLarge = 1 Then
        Dim lr As Long, fn As String, ln As String
        lr = Me.UsedRange.Rows.Count
        With Target
            If (.Row > 1 And .Row <= lr) And (.Column = 3 Or .Column = 4) Then
                fn = .Value2
                ln = .Offset(, 1).Value2
                If .Column = 4 Then
                    fn = .Offset(, -1).Value2
                    ln = .Value2
                End If
                FilterNames Sheet1, fn, ln
                FilterNames Sheet2, fn, ln
            Else
                If Sheet1.AutoFilterMode Then Sheet1.UsedRange.AutoFilter
                If Sheet2.AutoFilterMode Then Sheet2.UsedRange.AutoFilter
            End If
        End With
        Sheet1.Activate
    End If
End Sub