[已解决]求汇总表的vba代码

c0817

以进货明细和销售明细作为数据库， 求汇总表的vba代码.zip (10.24 KB, 下载次数: 32)

2012-8-16 16:23 上传

点击文件名下载附件 求汇总表的vba代码，详情见附件。请大师们，指点指点，万分感激！！！

最佳答案

月排行榜 / 总排行榜

jxncfxsf

2012-8-16 19:47

Sub 统计()
Dim m, i, n, q As Long
Dim arr, arr1, arr2, arr3, arr4, arr5
m = Sheets("货品数据").Range("a" & Rows.Count).End(xlUp).Row
n = Sheets("进货明细").Range("C" & Rows.Count).End(xlUp).Row
q = Sheets("销售明细").Range("c" & Rows.Count).End(xlUp).Row
arr1 = Sheets("货品数据").Range("a2:a" & m)
arr2 = Application.SumIf(Sheets("进货明细").Range("C2:C" & n), arr1, Sheets("进货明细").Range("j2:j" & n))
arr3 = Application.SumIf(Sheets("进货明细").Range("C2:C" & n), arr1, Sheets("进货明细").Range("l2:l" & n))
arr4 = Application.SumIf(Sheets("销售明细").Range("C2:C" & q), arr1, Sheets("销售明细").Range("j2:j" & q))
arr5 = Application.SumIf(Sheets("销售明细").Range("C2:C" & q), arr1, Sheets("销售明细").Range("l2:l" & q))
arr = Sheets("货品数据").Range("a2:s" & m)
For i = 1 To UBound(arr)
arr(i, 11) = arr2(i, 1)
arr(i, 13) = arr3(i, 1)
If arr(i, 11) <> 0 Then arr(i, 12) = arr(i, 13) / arr(i, 11)
arr(i, 14) = arr4(i, 1)
arr(i, 16) = arr5(i, 1)
If arr(i, 14) <> 0 Then arr(i, 15) = arr(i, 16) / arr(i, 14)
arr(i, 17) = arr(i, 8) + arr(i, 11) - arr(i, 14)
arr(i, 19) = arr(i, 10) + arr(i, 13) - arr(i, 16)
If arr(i, 17) <> 0 Then arr(i, 18) = arr(i, 19) / arr(i, 17)
Next i
Sheets("进销存统计").Range("a3:s" & Rows.Count).ClearContents
Sheets("进销存统计").Range("A3").Resize(UBound(arr), 19) = arr
End Sub

跳转到最佳答案楼层

c0817

高手们：指点指点吧！！！！谢谢！！！！！！！！！

jxncfxsf

Sub 统计()
Dim m, i, n, q As Long
Dim arr, arr1, arr2, arr3, arr4, arr5
m = Sheets("货品数据").Range("a" & Rows.Count).End(xlUp).Row
n = Sheets("进货明细").Range("C" & Rows.Count).End(xlUp).Row
q = Sheets("销售明细").Range("c" & Rows.Count).End(xlUp).Row
arr1 = Sheets("货品数据").Range("a2:a" & m)
arr2 = Application.SumIf(Sheets("进货明细").Range("C2:C" & n), arr1, Sheets("进货明细").Range("j2:j" & n))
arr3 = Application.SumIf(Sheets("进货明细").Range("C2:C" & n), arr1, Sheets("进货明细").Range("l2:l" & n))
arr4 = Application.SumIf(Sheets("销售明细").Range("C2:C" & q), arr1, Sheets("销售明细").Range("j2:j" & q))
arr5 = Application.SumIf(Sheets("销售明细").Range("C2:C" & q), arr1, Sheets("销售明细").Range("l2:l" & q))
arr = Sheets("货品数据").Range("a2:s" & m)
For i = 1 To UBound(arr)
arr(i, 11) = arr2(i, 1)
arr(i, 13) = arr3(i, 1)
If arr(i, 11) <> 0 Then arr(i, 12) = arr(i, 13) / arr(i, 11)
arr(i, 14) = arr4(i, 1)
arr(i, 16) = arr5(i, 1)
If arr(i, 14) <> 0 Then arr(i, 15) = arr(i, 16) / arr(i, 14)
arr(i, 17) = arr(i, 8) + arr(i, 11) - arr(i, 14)
arr(i, 19) = arr(i, 10) + arr(i, 13) - arr(i, 16)
If arr(i, 17) <> 0 Then arr(i, 18) = arr(i, 19) / arr(i, 17)
Next i
Sheets("进销存统计").Range("a3:s" & Rows.Count).ClearContents
Sheets("进销存统计").Range("A3").Resize(UBound(arr), 19) = arr
End Sub

c0817

谢谢！！！
万分感谢！！！

c0817

jxncfxsf 发表于 2012-8-16 19:47
Sub 统计()
Dim m, i, n, q As Long
Dim arr, arr1, arr2, arr3, arr4, arr5

模版2可以不要嘛？

jxncfxsf

呵呵，模块2 当然可以不要，是清除记录的代码不记得了，临时录制后复制过去的。后来忘记删了。