将一张表中的每个名称与另一张表中的每个名称进行比较

有两张名为“代理人”，另一张是“所有者”，现在代理人工作表中有大约37k行的“C”字样，“CLARKE，DENISE JANE”等名称都在一个单元格中。

另外一张表“所有者”的格式如“拉斐尔”，“威廉”，“史密斯”等等，在列A中的名字非常less。

我正在试图将代理表中的每个string与业主表中的每个名称进行比较。

在这种情况下。 首先拉斐尔将与CLARKE然后与迪尼然后与JANE比较，如果匹配被发现拉斐尔的背景颜色

现在当我运行这个代码的时候，它可能是一个无限循环或者什么东西，但是excel不会响应很长时间，比如5-8分钟就冻结了。 即使“Ctrl + Break”不起作用我必须通过任务pipe理器来终止它。 我试图find这个代码中的任何缺陷，但我无法这样做。

任何人都可以帮忙吗？

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