Question

有两张名为“Agents”的表，另一张是“Owners”，现在代理商表格在col“C”中有大约37,000行，名称如“CLARKE，DENISE JANE”全部在一个单元格中。

另一张“Owners”在col“A”中的名称非常少，约为1k行，格式如“Rafael”，“William”，“Smith”等，所有这些都在不同的行中。

我正在尝试将所有者表中的每个名称与代理商表中的每个字符串进行比较。

在这种情况下。首先将Rafael与CLARKE进行比较，然后与DENISE进行比较，然后使用JANE进行比较，如果匹配发现Rafael的背景颜色

现在当我运行这段代码时，它可能是一个无限循环或者其他东西，但是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

Answer 1

试一试。它更直接一点。由于需要处理大量数据，因此仍需要几分钟时间。

LookAt:=xlPart的查找选项让我们可以搜索该字段的任何部分。让我知道这个是否奏效。唯一的问题是我们可能有一个名为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

比较一张表中的每个名称与另一张表中的每个字符串

1 个答案: