VBAsumif功能

cut

己计算其中一列，请问其它列怎样计算呢？

汇总表的名称是固定的

Qs18

1. Sub qs()
   
2. Dim arr, i, dic
   
3. Set dic = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.UsedRange.Value
   
5. For i = 2 To UBound(arr)
   
6.     s = arr(i, 3)
   
7.     If Not dic.exists(s) Then
   
8.         dic(s) = Array(arr(i, 9), arr(i, 12), arr(i, 13))
   
9.     Else
   
10.         dic(s) = Array(dic(s)(0) + arr(i, 9), dic(s)(1) + arr(i, 12), dic(s)(2) + arr(i, 13))
    
11.     End If
    
12. Next
    
13. brr = Sheet2.UsedRange.Value
    
14. For i = 2 To UBound(brr)
    
15.     s = brr(i, 4)
    
16.     If dic.exists(s) Then
    
17.         ar = dic(s)
    
18.         For j = 0 To 2
    
19.             brr(i, j + 8) = ar(j)
    
20.         Next
    
21.     End If
    
22. Next
    
23. Sheet2.Range("a3").Resize(UBound(brr), UBound(brr, 2)) = brr
    
24. End Sub
    

复制代码

Qs18

试试...........

Qs18

试试............

cut

可以了，太感谢你了~

翁知江安

Sub sumiif()
Dim i, k, m, irow, irow1
Dim arr, brr, crr
Dim d1 As Object
Dim d2 As Object
Dim d3 As Object
Dim d4 As Object
Set d1 = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
Set d4 = CreateObject("scripting.dictionary")
irow = Sheets("明细").[c65536].End(xlUp).Row
arr = Sheets("明细").Range("a1:p" & irow)
For i = 5 To irow
   m = Month(arr(i, 2))
   d1(arr(i, 3) & m) = arr(i, 4) + d1(arr(i, 3) & m)
   d2(arr(i, 3) & m) = arr(i, 9) + d2(arr(i, 3) & m)
   d3(arr(i, 3) & m) = arr(i, 12) + d3(arr(i, 3) & m)
   d4(arr(i, 3) & m) = arr(i, 13) + d4(arr(i, 3) & m)
Next
irow1 = Sheets("汇总").[c65536].End(xlUp).Row
brr = Sheets("汇总").Range("a1:p" & irow)
ReDim crr(1 To irow - 4, 1 To 4)
For k = 5 To irow1
   crr(k - 4, 1) = d1(brr(k, 4) & brr(k, 6))
   crr(k - 4, 2) = d2(brr(k, 4) & brr(k, 6))
   crr(k - 4, 3) = d3(brr(k, 4) & brr(k, 6))
   crr(k - 4, 4) = d4(brr(k, 4) & brr(k, 6))
Next
Sheets("汇总").[g5].Resize(UBound(crr), 4) = crr
MsgBox "ok"
End Sub

翁知江安

这里将小时数也纳入了范围。

翁知江安

以上供参考，欢迎批评指正。为考虑运行方便，将前后的名称做了统一：如原明细表“计件金额”改成了计件工资。

听歌的海

练习一下，不过有个疑问，为何不用工号来确定人员呢？确认没有重名的员工吗？

1. Sub 计算汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheets("明细").[a4].CurrentRegion
   
4.     crr = Sheets("汇总").[a5].CurrentRegion
   
5.     ReDim brr(1 To UBound(arr), 1 To 4)
   
6.     For j = 2 To UBound(arr)
   
7.         m = arr(j, 3)
   
8.         If Not d.exists(m) Then
   
9.             t = t + 1
   
10.             d(m) = t
    
11.             brr(t, 1) = arr(j, 3)
    
12.             brr(t, 2) = arr(j, 9)
    
13.             brr(t, 3) = arr(j, 12)
    
14.             brr(t, 4) = arr(j, 13)
    
15.         Else
    
16.             r = d(m)
    
17.             brr(r, 2) = arr(j, 9) + brr(r, 2)
    
18.             brr(r, 3) = arr(j, 12) + brr(r, 3)
    
19.             brr(r, 4) = arr(j, 13) + brr(r, 4)
    
20.         End If
    
21.     Next j
    
22.     With Sheets("汇总")
    
23.         For j = 1 To UBound(crr)
    
24.             For y = 1 To UBound(brr)
    
25.                 If crr(j, 4) = brr(y, 1) Then
    
26.                     crr(j, 8) = brr(y, 2)
    
27.                     crr(j, 9) = brr(y, 3)
    
28.                     crr(j, 10) = brr(y, 4)
    
29.                 End If
    
30.                 If brr(y, 1) = "" Then Exit For
    
31.             Next y
    
32.         Next j
    
33.     .[a3].Resize(UBound(crr), 10) = crr
    
34.     End With
    
35. End Sub

复制代码