Office中国论坛/Access中国论坛

标题: 求VBA数据分类汇总代码 [打印本页]

---

作者: 文件管理    时间: 2017-6-12 15:43
标题: 求VBA数据分类汇总代码
以商品编码为对象，统计每个月的数量和平均单价（相同商品编码的成本金额之和除以数量）。

---

作者: 文件管理    时间: 2017-6-12 15:44
附件

---

作者: roych    时间: 2017-6-14 01:42
用数据透视表，自己处理下。
[attach]61586[/attach]

---

作者: 周义坤    时间: 2017-6-14 19:31

1. Sub ek_sky()
   
2.   Dim ar1 As Variant, ar2 As Variant
   
3.   Dim ro1 As Object
   
4.   Dim i As Long, j As Long, k As Long
   
5.   Set ro1 = CreateObject("scripting.dictionary")
   
6.     With Sheets("导出数据")
   
7.       ar1 = .Range("A3:I" & .Cells(.Rows.Count, 1).End(xlUp).Row)
   
8.     End With
   
9.       ReDim ar2(1 To UBound(ar1), 1 To 16)
   
10.         For i = 1 To UBound(ar1)
    
11.           If Not ro1.exists(ar1(i, 4)) Then
    
12.              j = j + 1
    
13.               ro1.Add ar1(i, 4), j
    
14.              ar2(j, 1) = ar1(i, 4): ar2(j, Month(ar1(i, 1)) + 1) = ar1(i, 8)
    
15.              ar2(j, 15) = ar1(i, 9): ar2(j, 16) = ar1(i, 8)
    
16.           Else
    
17.              ar2(ro1(ar1(i, 4)), Month(ar1(i, 1)) + 1) = ar1(i, 8) + ar2(ro1(ar1(i, 4)), Month(ar1(i, 1)) + 1)
    
18.              ar2(ro1(ar1(i, 4)), 15) = ar1(i, 9) + ar2(ro1(ar1(i, 4)), 15)
    
19.              ar2(ro1(ar1(i, 4)), 16) = ar1(i, 9) + ar2(ro1(ar1(i, 4)), 16)
    
20.           End If
    
21.         Next i
    
22.           For k = 1 To j
    
23.             ar2(k, 14) = Round(ar2(k, 15) / ar2(k, 16), 4)
    
24.          Next k
    
25.       Sheets("sheet1").Select
    
26.       Range("A:O").Clear
    
27.       Range("A1:O1") = Array("商品编码", "1月", "2月", "3月", "4月", "5月", "6月", "7月", "8月", "9月", "10月", "11月", "12月", "平均单价", "总金额")
    
28.       Range("A2").Resize(j, 15) = ar2
    
29. End Sub
    

复制代码

---

欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/)

Powered by Discuz! X3.3