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

〃高调的沉默

比对1月份-12月份的工资单，用VBA把结果显示在“结果”工作表里。
1、人员：后一个月（如2月份）与前一个月（如1月份）比，增加了谁，减少了谁，把姓名显示结果工作表的对应位置；
2、职务工资：后一个月（如2月份）与前一个月（如1月份）比，谁的职务工资变化了，把姓名显示结果工作表的对应位置。
新建文件夹.rar (3.48 KB, 下载次数: 35)

2014-11-15 11:04 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

xdragon

2014-11-17 00:23

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
    

复制代码

跳转到最佳答案楼层

〃高调的沉默

我不会vba。

〃高调的沉默

看来挺难滴……

〃高调的沉默

没人会了吗？

〃高调的沉默

大师们看看啊。

〃高调的沉默

真的没人会了吗？

〃高调的沉默

{:1112:}

〃高调的沉默

{:1512:}

〃高调的沉默

{:1112:}

〃高调的沉默

{:4212:}