|
统计表公式过多,会出现变慢的情况。能不能做个VBA代码,把销售记录表的‘箱数’统计到这个表格来
点了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
复制代码
|
|