VBA用两种方法比较AB两列相同和不同

laoau138

VBA用两种方法比较AB两列相同和不同

苏子龙

字典方法
Sub dd()
    Dim d As Object, arr, brr(1 To 1000)
    Dim i%, n%, x%
    Set d = CreateObject("scripting.dictionary")
    arr = Sheets("参赛队员信息").Range("a1").CurrentRegion
    For n = 1 To 2
        For i = 2 To UBound(arr)
        If Not d.exists(arr(i, n)) Then
                d.Add arr(i, n), ""
            Else
                 d.Remove arr(i, n)
                 x = x + 1
                 brr(x) = arr(i, n)
            End If
    Next i, n
    Range("g2").Resize(UBound(brr)) = Application.Transpose(brr)
    Range("h2").Resize(d.Count, 1) = Application.Transpose(d.keys)
    Set d = Nothing
End Sub

laoau138

苏子龙 发表于 2016-9-27 16:09
字典方法
Sub dd()
    Dim d As Object, arr, brr(1 To 1000)

还有数组方法，没有写

苏子龙

正好学学方法，2种方法都写了

laoau138

Sub tt()
    Dim arr, brr, crr
    Dim i%, n%, x%, y%
    arr = Sheets("参赛队员信息").Range("a1").CurrentRegion
    Range("d2:e2000").ClearContents
   
'brr作为临时数组，1，3放arr1,2数据，brr 2,4放是否重复
'用双循环将数据写入brr
    ReDim brr(1 To UBound(arr), 1 To 4)
    ReDim crr(1 To UBound(arr) * 2, 1 To 2)
    For n = 2 To UBound(arr)
        brr(n, 1) = arr(n, 1)
        For i = 2 To UBound(arr)
            brr(i, 3) = arr(i, 2)
            If arr(n, 1) = arr(i, 2) Then
                brr(n, 2) = brr(n, 2) + 2
                brr(i, 4) = brr(i, 4) + 2
            End If
    Next i, n
' 用brr2,4提取数据，将其保存到crr里
    For n = 2 To 4 Step 2
        For i = 2 To UBound(arr)
            If brr(i, n) > 1 Then
            x = x + 1
            If n = 2 Then crr(x, 1) = brr(i, n - 1)
        Else
            y = y + 1
            crr(y, 2) = brr(i, n - 1)
        End If
    Next i, n
    [d2].Resize(UBound(crr), 2) = crr
    Erase arr, brr, crr
End Sub