在Do循环中查找提供不一致结果的函数

Question

我正在尝试测试两个列表之间的差异。我的VBA代码应该在列表一中循环，并使用find方法查看列表二中的每一项。如果在列表2中找不到该项目，我会使用复制粘贴方法将其记录在比较表中。然后代码返回并执行相反的过程来测试列表一上的列表二；循环浏览列表2并查找列表1中的每一项。

我的结果意味着匹配结果的数量不一致。列表1中的项目数减去"list1"查找循环的结果不等于列表2中的项目数减"list2"查找循环中的项目数量。其余项目应仅为在每个列表中找到的值。

所有项目都是主键，在各自的列表中都是唯一的。

Public Sub compare_list()
Dim wsList2 As Worksheet
Dim wsList1 As Worksheet
Dim wsCompare As Worksheet
Dim found1 As Range
Set wsList2 = Worksheets("List2")
Set wsList1 = Worksheets("List1")
Set wsCompare = Worksheets("Compare")
Application.ScreenUpdating = False
'Check each value in client_id list one with list two
wsList1.Activate
wsList1.Range("a1").Select
Do Until ActiveCell.Value = ""
Set found1 = wsList2.Range("a1",_
wsList2.Range("A1048576").End(xlUp)).Find(Selection.Value)
    If found1 Is Nothing Then
    Selection.Copy
    wsCompare.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial
    End If
ActiveCell.Offset(1, 0).Select
Loop
'Check each value in client_id list two with list one
wsList2.Activate
wsList2.Range("a1").Select
Do Until ActiveCell.Value = ""
Set found1 = wsList1.Range("a1",_
wsList1.Range("A1048576").End(xlUp)).Find(Selection.Value)
        If found1 Is Nothing Then
        Selection.Copy
        wsCompare.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial
        End If
    ActiveCell.Offset(1, 0).Select 
Loop
wsCompare.Activate
Application.ScreenUpdating = True
End Sub  

请注意：我是VBA的新手，并不是来自开发人员的背景。你可能再也不能把你的解决方案搞得太笨了。

Answer 1

我的问题是find函数中的一个默认参数。我需要设置LookAt:=xlWhole

例如，列表1=（1,2,32142），列表2=（1,2,332）

出于我的目的，32不在列表2中，但在没有设置该参数的情况下，查找函数在包含132 的单元格中查找32时返回结果

以下是目前适用于我的代码。感谢您的帮助

Public Sub compare_list()
Dim wsList2 As Worksheet
Dim wsList1 As Worksheet
Dim wsCompare As Worksheet
Dim found1 As Range
Dim found2 As Range
Dim myCell As Range
Dim countList2 As Integer
Dim countList1 As Integer
Dim listDiff As Integer
Dim commonList2 As Integer
Dim commonList1 As Integer
Dim diffList1 As Integer
Dim diffList2 As Integer

Set wsList2 = Worksheets("List2")
Set wsList1 = Worksheets("List1")
Set wsCompare = Worksheets("Compare")
Application.ScreenUpdating = False
Application.CutCopyMode = False

'Check each value in the client_id list created by List1 to find an equal     value in List2's list
Set myCell = wsList1.Range("A1")
Do Until myCell.Value = ""
Set found1 = wsList2.Range("a1",   wsList2.Range("A1048576").End(xlUp)).Find(what:=myCell.Value, LookAt:=xlWhole)
    If found1 Is Nothing Then
    myCell.Copy
    wsCompare.Range("A1048576").End(xlUp).Offset(1, 0).PasteSpecial
    Else
    myCell.Copy
    wsCompare.Range("G1048576").End(xlUp).Offset(1, 0).PasteSpecial
    End If
Set myCell = myCell.Offset(1, 0)
Loop
'Check each value in the client_id list created by List2 to find an equesl value in List1's list
Set myCell = wsList2.Range("A1")
Do Until myCell.Value = ""
Set found2 = wsList1.Range("a1",  wsList1.Range("A1048576").End(xlUp)).Find(what:=myCell.Value, LookAt:=xlWhole)
    If found2 Is Nothing Then
    myCell.Copy
    wsCompare.Range("B1048576").End(xlUp).Offset(1, 0).PasteSpecial
    Else
    myCell.Copy
    wsCompare.Range("F1048576").End(xlUp).Offset(1, 0).PasteSpecial
    End If
Set myCell = myCell.Offset(1, 0)
 Loop
Application.ScreenUpdating = True
 wsCompare.Activate
'test logic of result
countList1 = wsList1.Range("a2", wsList1.Range("A1048576").End(xlUp)).Rows.count
countList2 = wsList2.Range("a2", wsList2.Range("a1048576").End(xlUp)).Rows.count

diffList1 = (wsCompare.Range("a2",   wsCompare.Range("A1048576").End(xlUp)).Rows.count - 1)
diffList2 = (wsCompare.Range("b2",     wsCompare.Range("b1048576").End(xlUp)).Rows.count - 1)
listDiff = Abs(countList1 - countList2)
commonList2 = (countList2 - diffList2)
commonList1 = (countList1 - diffList1)
MsgBox "List2 has " & commonList2 & " in common with List1" & vbCrLf & "List1     has " & commonList1 & " in common with List2"

End Sub