论坛 › Excel VBA开发 › 求助VBA代码

wulunting 发表于 2024-2-21 09:49

求助VBA代码

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

哥儿- 发表于 2024-2-22 21:41

……

哥儿- 发表于 2024-2-22 21:42

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

Sub 汇总(shName$)
    Dim arr, brr, i&, j&, dic As Object, num%, tempStr$, crr
    Set dic = VBA.CreateObject("scripting.dictionary")
    Sheets(shName).Range("h6:p18").ClearContents
    arr = Sheets(shName).Range("G4").CurrentRegion.Value
    num = UBound(arr, 2)
    For i = 5 To UBound(arr) - 2
      If arr(i, num) = "" Then arr(i, num) = Val(arr(i - 1, num)) & "年" & arr(i, 1)
      For j = 2 To UBound(arr, 2) - 2
            tempStr = Application.Clean(arr(i, num) & "\" & arr(4, j))
            dic(tempStr) = i & "," & j
      Next j
    Next i
    tempStr = Empty
    brr = Sheets("销售记录表").Range("A2").CurrentRegion.Value
    For i = 3 To UBound(brr)
      tempStr = VBA.Format(brr(i, 6), "yyyy年m月份") & "\" & Application.Clean(brr(i, 8))
      If dic.exists(tempStr) Then
            crr = Split(dic(tempStr), ",")
            arr(crr(0) * 1, crr(1) * 1) = arr(crr(0) * 1, crr(1) * 1) + brr(i, 13)
      End If
    Next i
    For i = 5 To UBound(arr) - 2
      For j = 2 To UBound(arr, 2) - 2
            arr(i, num - 1) = arr(i, num - 1) + arr(i, j)
      Next j
    Next i
    Sheets(shName).Range("G2").Resize(UBound(arr), UBound(arr, 2)) = arr
    MsgBox "汇总完成 ！"
End Sub
Sub 直口()
    Call 汇总("直口统计表")
End Sub

Sub 螺口()
    Call 汇总("螺口统计表")
End Sub

wulunting 发表于 2024-2-23 19:07

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

查看完整版本: 求助VBA代码