请老师帮忙VBA

574755961

一把小刀闯天下 发表于 2018-7-11 10:38
'如果速度慢换个快排

Option Explicit

谢谢老师，对的，就是量大，想要快点，请老师帮我快排下，我学习中，谢谢

574755961

朱荣兴 发表于 2018-7-11 10:54
vba数组十字典的问题，但不明白具体的要求呀

就是BC列，且C列是非空单无格，分类汇总，在目标表里，谢谢老师

lenghonghai601

1. Sub test()
   
2. Dim cnn As Object, arr, brr(), i&
   
3. Set cnn = CreateObject("adodb.connection")
   
4. cnn.Open "provider=microsoft.jet.oledb.4.0;extended properties=excel 8.0;data source=" & ThisWorkbook.FullName
   
5. mysql = "select 区域,数据,sum(数量) from [原表$] group by 区域,数据 order by 区域 asc"
   
6. arr = WorksheetFunction.Transpose(cnn.Execute(mysql).getrows)
   
7. ReDim brr(1 To UBound(arr), 1 To 2)
   
8. cnn.Close
   
9. mysum = 0: Sum = 0
   
10. For i = 1 To UBound(arr) - 1
    
11.     If mysum = 0 Then mysum = arr(i, 3)
    
12.     If arr(i, 1) = arr(i + 1, 1) Then
    
13.         mysum = mysum + arr(i + 1, 3)
    
14.     Else
    
15.         brr(i, 1) = mysum
    
16.         mysum = 0
    
17.     End If
    
18.     Sum = Sum + arr(i, 3)
    
19. Next i
    
20. brr(i, 1) = mysum: brr(i, 2) = Sum + arr(i, 3)
    
21. Sheet2.Range("b3").Resize(UBound(arr), 3) = arr
    
22. Sheet2.Range("e3").Resize(UBound(brr), 2) = brr
    
23. End Sub
    

复制代码

574755961

lenghonghai601 发表于 2018-7-11 13:05

谢谢老师，就是这样的结果