[已解决]dsmch老师，有空帮我看看，谢谢。

新一

红色底纹的工作表中，明细表的E列，计件工资，是由总工序表+装模=计件工资，我想用VBA实现SUMIF函数功能的求和，因为总工序表中，已设置了VBA更新，如果明细表中用SUMIF函数公式，那么总工序表更新反映变慢，可否帮我解决，谢谢。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-22 20:42

刷新的同时填充明细表数据

跳转到最佳答案楼层

dsmch

模拟两人以上结果，方便用数组测试。

新一

dsmch 发表于 2014-4-22 19:43
模拟两人以上结果，方便用数组测试。

附件已修改，主要是想用VBA实现满足条件求和，明细表的E列。

dsmch

1. Sub Macro1()
   
2. On Error Resume Next
   
3. Dim arr, brr, crr(1 To 16, 1 To 8), d
   
4. Dim n&, k%, j&, i&, s&, ar, br, cr
   
5. Set d = CreateObject("scripting.dictionary")
   
6. br = Sheets("装模").Range("a1").CurrentRegion
   
7. cr = Sheets("明细表").Range("b5:b" & Sheets("明细表").Range("b65536").End(xlUp).Row)
   
8. Range("a3:h65536").ClearContents
   
9. n = 3
   
10. For k = 1 To 2
    
11.     arr = Sheets(k).UsedRange
    
12.     For i = 2 To UBound(arr)
    
13.         If InStr(arr(i, 1), "对应单号") And Len(arr(i, 1)) > 5 Then
    
14.             brr = Sheets(k).Cells(i, 1).Resize(16, 8)
    
15.             y = Val(brr(1, 6)): m = Val(brr(1, 7)): r = Val(brr(1, 8))
    
16.             rq = DateSerial(y, m, r)
    
17.             dh = Mid(brr(1, 1), 6)
    
18.             mc = Mid(brr(2, 1), 4)
    
19.             s = 0
    
20.             For j = 4 To UBound(brr)
    
21.                 If brr(j, 2) <> "" Then
    
22.                     s = s + 1
    
23.                     crr(s, 1) = rq
    
24.                     crr(s, 2) = dh
    
25.                     crr(s, 3) = mc
    
26.                     crr(s, 4) = brr(j, 2)
    
27.                     crr(s, 5) = brr(j, 5)
    
28.                     crr(s, 6) = brr(j, 6)
    
29.                     crr(s, 7) = brr(j, 7)
    
30.                     crr(s, 8) = brr(j, 3)
    
31.                 End If
    
32.             Next
    
33.             Cells(n, 1).Resize(s, UBound(crr, 2)) = crr
    
34.             n = n + s
    
35.         End If
    
36.     Next
    
37. Next
    
38. x = Sheet3.Range("a65536").End(xlUp).Row
    
39. If x < 3 Then Exit Sub
    
40. Sheet3.Range("a3:h" & x).Copy Cells(n, 1)
    
41. ar = Range("a1").CurrentRegion
    
42. For i = 3 To UBound(ar)
    
43.     d(ar(i, 8)) = d(ar(i, 8)) + ar(i, 7)
    
44. Next
    
45. For i = 2 To UBound(br)
    
46.     d(br(i, 8)) = d(br(i, 8)) + br(i, 7)
    
47. Next
    
48. For i = 1 To UBound(cr)
    
49.     cr(i, 1) = d(cr(i, 1))
    
50. Next
    
51. Sheets("明细表").Range("e5").Resize(UBound(cr)) = cr
    
52. End Sub
    

复制代码

dsmch

刷新的同时填充明细表数据

新一

非常感谢