Sub 工资条()
Dim crr()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
r = [a65536].End(xlUp).Row
arr = Range("a2:c" & r)
ReDim brr(1 To UBound(arr), 1 To 3)
For i = 1 To UBound(arr)
s = arr(i, 1) & "/" & arr(i, 2)
d1(arr(i, 1)) = ""
If Not d.exists(s) Then d(s) = d.Count + 1
brr(d(s), 1) = arr(i, 1)
brr(d(s), 2) = arr(i, 2)
brr(d(s), 3) = brr(d(s), 3) + arr(i, 3)
k = k + 1
Next i
n = 1
For i = 0 To UBound(d1.keys)
s = d1.keys()(i)
X = 2
ReDim Preserve crr(1 To 6, 1 To 20)
For m = 1 To UBound(brr)
If brr(m, 1) = s Then
crr(n, 1) = brr(m, 1)
crr(n, X) = brr(m, 2)
crr(n + 1, X) = brr(m, 3)
X = X + 1
End If
Next m
n = n + 2
Next i
For i = 1 To UBound(crr)
If InStr(crr(i, 1), "员工") = 1 Then
For j = 1 To UBound(crr, 2)
If crr(i, j) = "" Then
crr(i, j) = "合计"
Exit For
End If
Next j
Else
For j = 2 To UBound(crr, 2)
If crr(i, j) = "" Then
crr(i, j) = WorksheetFunction.Sum(WorksheetFunction.Index(crr, i, 0))
Exit For
End If
Next j
End If
Next i
[e2].Resize(UBound(crr), UBound(crr, 2)) = crr
End Sub |