[已解决]再次求助VBA对比人员及工资变化情况

xdragon

1. Sub 比较异同()
   
2.    Dim arr, brr, i&, k%, d As Object, re(), cnt%(1 To 3), tmp
   
3.    For k = 2 To 12
   
4.        arr = Sheets(k - 1 & "月份").Range("A1").CurrentRegion.Value
   
5.        brr = Sheets(k & "月份").Range("A1").CurrentRegion.Value
   
6.        ReDim re(1 To UBound(arr) + UBound(brr), 1 To 3)
   
7.        Set d = CreateObject("scripting.dictionary")
   
8.        For i = 2 To UBound(arr)
   
9.            d(arr(i, 1)) = arr(i, 2)
   
10.        Next
    
11.        For i = 2 To UBound(brr)
    
12.            If Not d.exists(brr(i, 1)) Then
    
13.                cnt(2) = cnt(2) + 1
    
14.                re(cnt(2), 2) = brr(i, 1)
    
15.            Else
    
16.                If d(brr(i, 1)) <> brr(i, 2) Then cnt(3) = cnt(3) + 1: re(cnt(3), 3) = brr(i, 1)
    
17.                d.Remove (brr(i, 1))
    
18.            End If
    
19.        Next
    
20.        tmp = d.keys
    
21.        For i = 0 To UBound(tmp)
    
22.            re(i + 1, 1) = tmp(i)
    
23.        Next
    
24.        Range("A4").Offset(, (k - 2) * 3).Resize(UBound(re), 3) = re
    
25.        Erase cnt
    
26.        d.RemoveAll
    
27.        Set d = Nothing
    
28.    Next
    
29. End Sub
    

复制代码