统计1到12月份的总的工资

neoplanz

因工作需要，需要统计出某一个人1到12月的总的工资数据，最好是能做一个按钮，可以输入身份证号码，然后自动计算出总的工资数，人名有重复的，身份证号码是唯一的，见附件，在线急等，多谢多谢！

mikezhan

Sub test()
Application.ScreenUpdating = False
Dim arr, brr, crr()
Set dic = CreateObject("scripting.dictionary")
For Each sht In Worksheets
    If sht.Name <> "查找" Then
        sht.Activate

        arr = Range("B3:D" & Cells(Rows.Count, 2).End(xlUp).Row)
        For i = 1 To UBound(arr)
            x1 = arr(i, 1)
            x2 = "'" & arr(i, 2)
            x3 = arr(i, 3)
            y = sht.Name
            If dic(x2) = "" Then
                dic(x2) = x1 & "," & y & ";" & x3
            Else
                dic(x2) = dic(x2) & "," & y & ";" & x3
            End If
        Next
    End If
Next
ReDim crr(1 To dic.Count, 1 To 14)

Sheets("查找").Activate
For Each k In dic.keys
    brr = Split(dic(k), ",")
    m = m + 1
    crr(m, 1) = k
    crr(m, 2) = brr(0)
    For n = 1 To 12
        For j = 1 To UBound(brr)
            drr = Split(brr(j), ";")
            If Val(drr(0)) = n Then
                crr(m, n + 2) = Val(drr(1))
            End If
        Next
    Next
Next

[A2].Resize(UBound(crr), 14) = crr

Application.ScreenUpdating = True


End Sub

这样???/