Question

我用它来查看哪些客户已添加到我们的客户列表中，哪些客户已经离开，每月一次。

它需要两个列表，然后输出两个列表中的唯一和公共成员。可能有更好的方法来做到这一点，但逻辑很简单，易于遵循，似乎有效。例如

一个乙 A 的乙 AB
1 3 1 五 3

2 4 2 6 4

3 5

4 6

Option Base 1

Sub UniqueMembersOfTwoLists()

Dim arrOne() As Variant  
Dim arrTwo() As Variant  
Dim AB() As Variant  
ReDim AB(0 To 0) As Variant  
Dim A_Only() As Variant  
ReDim A_Only(0 To 0) As Variant  
Dim OnlyInListB() As Variant  
ReDim OnlyInListB(0 To 0) As Variant

Dim lrOne As Long  
Dim lrTwo As Long

Dim r1 As Range  
Dim r2 As Range  
Dim i As Long  
Dim test As Variant  
Dim g As Boolean

‘Dim ms As String  
‘ if needed  
‘ms = "Put list 1 in column A starting in A1, put list 2 in column B staring B1"  
‘MsgBox ms  

lrOne = Range("A65336").End(xlUp).Row  
lrTwo = Range("B65336").End(xlUp).Row

Set r1 = Range((Cells(1, 1)), (Cells(lrOne, 1)))  
Set r2 = Range((Cells(1, 2)), (Cells(lrTwo, 2)))

arrOne = r1  
arrTwo = r2

‘simple check to see if each member of list B is in List A  
For Each Element In arrTwo  
    test = Element  
    g = contained(arrOne, test)  

    If g = True Then  
        ' means is a member of both lists, add to common members list  
        ReDim Preserve AB(0 To UBound(AB) + 1)  
        AB(UBound(AB)) = test

    Else
        ‘means only in list A, so add to A only  
        ReDim Preserve A_Only(0 To UBound(A_Only) + 1)    
        A_Only(UBound(A_Only)) = test

    End If

Next Element

‘ then repeat the other way round to find only in list B  

For Each w In arrOne  
    test = w  
    g = contained(arrTwo, test)  

    If g = True Then  
        ' means is a member of both lists, already added so do nothing  
    Else  
        ReDim Preserve OnlyInListB(0 To UBound(OnlyInListB) + 1)  
        OnlyInListB(UBound(OnlyInListB)) = test  
    End If  

Next w

' out put to sheet  

For i = 1 To UBound(AB)  
    Cells(i, 5).Value = AB(i)  
Next i  
i = 1  

For i = 1 To UBound(A_Only)  
    Cells(i, 4).Value = A_Only(i)  
Next i  
i = 1  

For i = 1 To UBound(OnlyInListB)  
    Cells(i, 3).Value = OnlyInListB(i)  
Next i  
i = 1  

‘ tidy up

Rows("1:1").Select  
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  
Range("A1").Select  
ActiveCell.FormulaR1C1 = "List A"  
Range("B1").Select  
ActiveCell.FormulaR1C1 = "List B"  
Range("C1").Select  
ActiveCell.FormulaR1C1 = "Only in List A"  
Range("D1").Select  
ActiveCell.FormulaR1C1 = "Only in List B"  
Range("E1").Select  
ActiveCell.FormulaR1C1 = "In both A & B"  
Rows("1:1").Select  
Selection.Font.Bold = True      
Cells.Select  
Cells.EntireColumn.AutoFit  

End Sub

Function contained(arr() As Variant, test As Variant)  
Dim i As Long  
Dim a As Variant  
Dim g As Boolean  
g = False  

For i = 1 To UBound(arr)  
    a = arr(i, 1)  
    If a = test Then  
        g = True  
        Exit For  
    Else  
    End If  
Next i  

contained = g  

End Function

是否有更有效的方法来实现相同的目标，可能使用字典？

两个列表的唯一成员

0 个答案: