汇总数据求提速

张雄友

汇总数据求提速，几万行模拟数据用了7分钟，耗用97% 的内存。以前厂人多每月有13万行数据，现在人少了也有9万多行每月。

张文洲

可以考虑做个透视表，虽然汇总结构有所变化，但是依然很直观，尤其是效率很高

笑着...两年过去

干嘛不做个系统什么的了？

cbtaja

试试看，处理本例6万行数据在我的机器上用时约0.7秒：

1. Sub cbtaja()
   
2. Dim arr, brr, d, d2, i&, j&, k&, zl&, r&, h&, l&, p&, t#, ghgx$, tmp
   
3. t = Timer
   
4. Set d = CreateObject("scripting.dictionary")
   
5. arr = Sheet2.Range("A1").CurrentRegion
   
6. r = UBound(arr)
   
7. ReDim brr(1 To 5000) '假设工人人数5000以内
   
8. ReDim crr(1 To 5000, 1 To 256) '假设工序256以内
   
9. For i = 2 To r
   
10.     arr(i, 2) = Format(arr(i, 2), String(8, "0"))
    
11.     ghgx = arr(i, 2) & arr(i, 11)
    
12.     If Not d.Exists(arr(i, 2)) Then
    
13.         h = h + 1
    
14.         d(arr(i, 2)) = h
    
15.         brr(h) = 2
    
16.         d(ghgx) = 2
    
17.         crr(h, 1) = arr(i, 2)
    
18.         crr(h, 2) = Array(arr(i, 8), arr(i, 11), arr(i, 14))
    
19.     Else
    
20.         p = d(arr(i, 2))
    
21.         If d.Exists(ghgx) Then
    
22.             l = d(ghgx)
    
23.             tmp = crr(p, l)
    
24.             tmp(2) = tmp(2) + arr(i, 14)
    
25.             If InStr(tmp(0), arr(i, 8)) = 0 Then tmp(0) = tmp(0) & "/" & arr(i, 8)
    
26.             crr(p, l) = tmp
    
27.         Else
    
28.             l = brr(p) + 1
    
29.             d(ghgx) = l
    
30.             If zl < l Then zl = l
    
31.             brr(p) = l
    
32.             crr(p, l) = Array(arr(i, 8), arr(i, 11), arr(i, 14))
    
33.         End If
    
34.     End If
    
35. Next
    
36. For i = 1 To h
    
37.     For j = 2 To brr(i)
    
38.         If IsArray(crr(i, j)) Then
    
39.             If InStr(crr(i, j)(0), "/") > 0 Then crr(i, j)(0) = "(" & crr(i, j)(0) & ")"
    
40.             crr(i, j) = Join(crr(i, j), " ") & "件"
    
41.         End If
    
42.     Next
    
43. Next
    
44. Sheet1.Range("A2").Resize(h, zl) = crr
    
45. MsgBox Timer - t
    
46. End Sub

复制代码

张雄友

cbtaja 发表于 2015-3-13 00:41
试试看，处理本例6万行数据在我的机器上用时约0.7秒：

数据少时，反而运行时错误1004。

笑着...两年过去

张雄友 发表于 2015-3-13 07:29
数据少时，反而运行时错误1004。

为什么不在系统里做处理了？

suwenkai

试一下自定义结构做一下了（也是随便做的，基本是没有什么算法的。）。

1. Type myindex
   
2.     name As String
   
3.     no As String
   
4.     d As Object
   
5.     capacity As Long
   
6. End Type
   
7. Type mylist
   
8.     workNo As Long
   
9.     d As Object
   
10.     list() As myindex
    
11.     count As Long
    
12. End Type
    
13. 
    
14. Sub 按钮7_Click()
    
15.     Dim d As Object, ds As Object
    
16.     Dim a() As mylist
    
17.     mytime = Timer
    
18.     Set d = CreateObject("scripting.dictionary")
    
19.     Set ds = CreateObject("scripting.dictionary")
    
20. 
    
21.     arr = Sheets("交飞明细").Range("a1").CurrentRegion
    
22.     For i = 1 To UBound(arr, 2)
    
23.         d(arr(1, i)) = i
    
24.     Next
    
25.     For i = 2 To UBound(arr)
    
26.         If Not ds.Exists(arr(i, d("工号"))) Then
    
27.             n = n + 1
    
28.             ds(arr(i, d("工号"))) = n
    
29.             ReDim Preserve a(1 To n)
    
30.             With a(n)
    
31.                 .workNo = arr(i, d("工号"))
    
32.                 .count = 1
    
33.                 Set .d = CreateObject("scripting.dictionary")
    
34.                 .d(arr(i, d("工序名称"))) = .count
    
35.                 ReDim Preserve .list(1 To 1)
    
36.                 With .list(1)
    
37.                     Set .d = CreateObject("scripting.dictionary")
    
38.                     .d(arr(i, d("制单号"))) = ""
    
39.                     .name = arr(i, d("工序名称"))
    
40.                     .no = arr(i, d("制单号"))
    
41.                     .capacity = arr(i, d("产量"))
    
42.                 End With
    
43.             End With
    
44.         Else
    
45.             With a(ds(arr(i, d("工号"))))
    
46.                 If Not .d.Exists(arr(i, d("工序名称"))) Then
    
47.                     .count = .count + 1
    
48.                     If .count > Max Then Max = .count
    
49.                     .d(arr(i, d("工序名称"))) = .count
    
50.                     ReDim Preserve .list(1 To .count)
    
51.                     With .list(.count)
    
52.                         .name = arr(i, d("工序名称"))
    
53.                         Set .d = CreateObject("scripting.dictionary")
    
54.                         .d(arr(i, d("制单号"))) = ""
    
55.                         .no = arr(i, d("制单号"))
    
56.                         .capacity = arr(i, d("产量"))
    
57.                     End With
    
58.                 Else
    
59.                     With .list(.d(arr(i, d("工序名称"))))
    
60. 
    
61.                         If Not .d.Exists((arr(i, d("制单号")))) Then
    
62.                             .no = .no & "" & arr(i, d("制单号"))
    
63.                         End If
    
64.                         .capacity = .capacity + arr(i, d("产量"))
    
65.                     End With
    
66.                 End If
    
67.             End With
    
68.         End If
    
69.     Next
    
70. 
    
71.     ReDim brr(1 To UBound(a), 1 To Max + 1)
    
72.     For i = 1 To UBound(a)
    
73. 
    
74.         brr(i, 1) = a(i).workNo
    
75.         For j = 1 To a(i).count
    
76. 
    
77.             brr(i, j + 1) = a(i).list(j).no & " " & a(i).list(j).name & " " & a(i).list(j).capacity & "件"
    
78. 
    
79.         Next
    
80. 
    
81.     Next
    
82.     Sheets("get").Range("a2").Resize(n, Max + 1) = brr
    
83.     MsgBox Timer - mytime
    
84. End Sub
    

复制代码

cbtaja

张雄友 发表于 2015-3-13 07:29
数据少时，反而运行时错误1004。

对变量zl需要赋初值。
请把以下这行代码添加到楼上第7行之前：

1. If r > 1 Then zl = 2 Else Exit Sub

复制代码

张雄友

笑着...两年过去 发表于 2015-3-13 08:25
为什么不在系统里做处理了？

我在公司是一个普通的会计员，不是程序设计师。

张雄友

suwenkai 发表于 2015-3-13 10:59
试一下自定义结构做一下了（也是随便做的，基本是没有什么算法的。）。

刚下班，测试一下，下标出错了。