Vba 将一张工作表中的每个名称与另一张工作表中的每个字符串进行比较

有两张表格名为“Agents”，另一张是“Owners”。现在Agents表格在C栏有大约37k行，名字像“CLARKE，DENISE JANE”都在一个单元格中

另一张“Owners”的A列中大约有1k行的名字，格式类似于“Rafael”、“William”、“Smith”等，都在不同的行中

我试图将所有者表中的每个名称与代理表中的每个字符串进行比较

在这种情况下。首先将拉斐尔和克拉克进行比较，然后是丹尼斯，然后是简，如果发现拉斐尔的背景色匹配的话

现在，当我运行这段代码时，它可能会进入一个无限循环或者其他什么，但是excel在很长一段时间内没有响应，就像5-8分钟冻结一样。即使“Ctrl+Break”也不行，我必须通过任务管理器终止它。我试图找出这段代码中的任何缺陷，但我没能做到

有人能帮忙吗

Option Explicit
Sub Duplica()
    Dim str1 As String
    Dim str2 As String
    Dim i, j, m, d, k, l As Long
    Dim FinalRow, FinalRow1 As Long
    Dim ws, wr As Worksheet
    Dim pos As Integer
    Dim Own
    Dim Ago

    Application.ScreenUpdating = False
    Set ws = Sheets("Agents")
    Set wr = Sheets("Owners")

    FinalRow = ws.Range("C90000").End(xlUp).Row
    FinalRow1 = wr.Range("A90000").End(xlUp).Row

    For i = 1 To FinalRow
        l = 0
        pos = 0

        With ws
        str1 = .Cells(i, "C").Text
        str1 = Replace(str1, "&", " ")
        str1 = Replace(str1, ",", " ")
        Ago = Split(str1, " ")
        End With

        For d = 1 To FinalRow1
            With wr
            str2 = .Cells(d, "A").Text
            str2 = Replace(str2, "&", " ")
            str2 = Replace(str2, ",", " ")
            Own = Split(str2, " ")
            End With

            For m = LBound(Ago) To UBound(Ago)
                For j = LBound(Own) To UBound(Own)
                    If Len(Own(j)) > 0 And Len(Ago(m)) > 0 Then     'if not a empty string
                    pos = InStr(1, Ago(m), Own(j), vbTextCompare)    'Find the owners name in Agents name
                    If Own(j) = Ago(m) Then                           'If both are same
                    l = l + 1                                          'increment l
                    Else: End If
                    Else: End If

                    If l > 0 Or pos >= 1 Then
                    With wr
                    .Cells(d, "A").Interior.ColorIndex = 3
                    End With
                    l = 0
                    pos = 0
                    Else: End If
                    l = 0
                    pos = 0

                Next j
            Next m
        Next d
    Next i
End Sub

---

试试这个。这有点直截了当。这仍然需要几分钟的时间，因为这需要处理大量数据

LookAt:=xlPart

的find选项提供了对字段任何部分的搜索。让我知道这是否有效。唯一的问题是我们可能有一个叫bob的所有者和一个叫Jimbob的代理。那会很成功的。如果这是一个问题，我们可以将其更改为查看每个名称

Sub Duplica()

    Dim wsAgents As Excel.Worksheet
    Dim wsOwners As Excel.Worksheet
    Dim lRow As Long
    Dim Rng As Range
    Dim lastRow As Long

    Set wsAgents = ActiveWorkbook.Sheets("Agents")
    Set wsOwners = ActiveWorkbook.Sheets("Owners")

    'Get the last row that has an owner name
    lastRow = wsOwners.Cells(wsOwners.Rows.count, "A").End(xlUp).Row

    'Loop through the sheet with the owners
    lRow = 1
    Do While lRow <= lastRow

        'Search for the owners name in the column on the agents sheet.
        Set Rng = wsAgents.Range("C:C").Find(What:=UCase(wsOwners.Range("A" & lRow).Value), _
                        LookIn:=xlValues, _
                        LookAt:=xlPart, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlNext, _
                        MatchCase:=False)

        'If we found the owner on the agent sheet color the owners name red.
        If Not Rng Is Nothing Then
            wsOwners.Range("A" & lRow).Interior.ColorIndex = 3
        End If
    Debug.Print str(lRow)

    'Increment to the next row
    lRow = lRow + 1
    Loop

End Sub

Sub-Duplica（）
将WSAgent设置为Excel.Worksheet
将wsOwners设置为Excel.工作表
暗淡的光线和长的一样
变暗Rng As范围
最后一排一样长
设置wsAgents=ActiveWorkbook.Sheets（“代理”）
设置wsOwners=ActiveWorkbook.Sheets（“所有者”）
'获取具有所有者名称的最后一行
lastRow=wsOwners.Cells（wsOwners.Rows.count，“A”）.End（xlUp）.Row
'与所有者一起循环浏览工作表
lRow=1
当lRow运行时是否在finalRow上运行debug.print？此外，您是否意识到，除了最后一个变量之外，所有变量都声明为类型变量？对于这两种类型的工作表，您必须执行
dim ws as worksheet，wr as worksheet
。我认为由于您的四个嵌套for循环，这需要很长时间。几乎总有比拥有那么多for循环更好的逻辑。它为我运行，但我没有您工作表上的数据，因此很难知道这是否导致了问题。您的
FinalRow
、
UBound（Ago）
和
UBound（Own）
值是多少？所有3个都在三重嵌套循环中使用，这基本上意味着迭代次数=所有的乘法3@MatthewD如果需要，您可以在此处查看该文件：@Raugmor FinalRow大于37k，Ubound（Ago）小于4，Ubound（Own）在所有行中几乎等于1。@Rohan K修复了一个错误并提高了速度。我认为应该是
如果不是Rng什么都不是，那么
@MatthewD这是什么魔法？谢谢男人：）@BrakNicku是正确的。根据结果我认为是另一个。