[已解决]求助VBA代码

wulunting

统计表公式过多，会出现变慢的情况。能不能做个VBA代码，把销售记录表的‘箱数’统计到这个表格来

最佳答案

月排行榜 / 总排行榜

哥儿-

2024-2-22 21:42

点了N次才上传上来 ，我也是醉了

1. Option Explicit
   
2. 
   
3. Sub 汇总(shName$)
   
4.     Dim arr, brr, i&, j&, dic As Object, num%, tempStr$, crr
   
5.     Set dic = VBA.CreateObject("scripting.dictionary")
   
6.     Sheets(shName).Range("h6:p18").ClearContents
   
7.     arr = Sheets(shName).Range("G4").CurrentRegion.Value
   
8.     num = UBound(arr, 2)
   
9.     For i = 5 To UBound(arr) - 2
   
10.         If arr(i, num) = "" Then arr(i, num) = Val(arr(i - 1, num)) & "年" & arr(i, 1)
    
11.         For j = 2 To UBound(arr, 2) - 2
    
12.             tempStr = Application.Clean(arr(i, num) & "" & arr(4, j))
    
13.             dic(tempStr) = i & "," & j
    
14.         Next j
    
15.     Next i
    
16.     tempStr = Empty
    
17.     brr = Sheets("销售记录表").Range("A2").CurrentRegion.Value
    
18.     For i = 3 To UBound(brr)
    
19.         tempStr = VBA.Format(brr(i, 6), "yyyy年m月份") & "" & Application.Clean(brr(i, 8))
    
20.         If dic.exists(tempStr) Then
    
21.             crr = Split(dic(tempStr), ",")
    
22.             arr(crr(0) * 1, crr(1) * 1) = arr(crr(0) * 1, crr(1) * 1) + brr(i, 13)
    
23.         End If
    
24.     Next i
    
25.     For i = 5 To UBound(arr) - 2
    
26.         For j = 2 To UBound(arr, 2) - 2
    
27.             arr(i, num - 1) = arr(i, num - 1) + arr(i, j)
    
28.         Next j
    
29.     Next i
    
30.     Sheets(shName).Range("G2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
31.     MsgBox "汇总完成 ！"
    
32. End Sub
    
33. Sub 直口()
    
34.     Call 汇总("直口统计表")
    
35. End Sub
    
36. 
    
37. Sub 螺口()
    
38.     Call 汇总("螺口统计表")
    
39. End Sub
    

复制代码

跳转到最佳答案楼层

哥儿-

……

哥儿-

点了N次才上传上来 ，我也是醉了

1. Option Explicit
   
2. 
   
3. Sub 汇总(shName$)
   
4.     Dim arr, brr, i&, j&, dic As Object, num%, tempStr$, crr
   
5.     Set dic = VBA.CreateObject("scripting.dictionary")
   
6.     Sheets(shName).Range("h6:p18").ClearContents
   
7.     arr = Sheets(shName).Range("G4").CurrentRegion.Value
   
8.     num = UBound(arr, 2)
   
9.     For i = 5 To UBound(arr) - 2
   
10.         If arr(i, num) = "" Then arr(i, num) = Val(arr(i - 1, num)) & "年" & arr(i, 1)
    
11.         For j = 2 To UBound(arr, 2) - 2
    
12.             tempStr = Application.Clean(arr(i, num) & "" & arr(4, j))
    
13.             dic(tempStr) = i & "," & j
    
14.         Next j
    
15.     Next i
    
16.     tempStr = Empty
    
17.     brr = Sheets("销售记录表").Range("A2").CurrentRegion.Value
    
18.     For i = 3 To UBound(brr)
    
19.         tempStr = VBA.Format(brr(i, 6), "yyyy年m月份") & "" & Application.Clean(brr(i, 8))
    
20.         If dic.exists(tempStr) Then
    
21.             crr = Split(dic(tempStr), ",")
    
22.             arr(crr(0) * 1, crr(1) * 1) = arr(crr(0) * 1, crr(1) * 1) + brr(i, 13)
    
23.         End If
    
24.     Next i
    
25.     For i = 5 To UBound(arr) - 2
    
26.         For j = 2 To UBound(arr, 2) - 2
    
27.             arr(i, num - 1) = arr(i, num - 1) + arr(i, j)
    
28.         Next j
    
29.     Next i
    
30.     Sheets(shName).Range("G2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
31.     MsgBox "汇总完成 ！"
    
32. End Sub
    
33. Sub 直口()
    
34.     Call 汇总("直口统计表")
    
35. End Sub
    
36. 
    
37. Sub 螺口()
    
38.     Call 汇总("螺口统计表")
    
39. End Sub
    

复制代码

wulunting

真好，真厉害，不是一般的厉害，是大大的厉害