知方号

知方号

用VBA完成报表制作

用VBA完成报表制作

最近帮朋友做了一个报表统计的excel,因为本人比较懒,就直接用vba写了逻辑,而没有使用公式,代码实现了一些较简单的功能,例:算总收入,总支出,按月份统计的报销额度,根据财务人员给的公式自动算出管理费等,在这里mark一下,语言不是最重要的,重要的是解决问题的思路,与君共勉。因为我只对sheet1做了宏处理,所以在代码中使用worksheets(1)来查找sheet1中的单元格。有需要也可以更改成对整个工作簿作用。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)Dim i, ji = 0j = 0inner = 0outer = 0Dim cost(1 To 12) As LongDim earn(1 To 12) As LongFor r = 2 To Worksheets(1).UsedRange.Rows.Count If r = 2 Then If Worksheets(1).Cells(r, 5).Value "" Then Worksheets(1).Cells(r, 9).Value = (Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 8).Value) * 0.08 Worksheets(1).Cells(r, 6).Value = Worksheets(1).Cells(r, 8).Value + Worksheets(1).Cells(r, 9).Value Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value If Worksheets(1).Cells(r, 2).Value "" Then//实现按月统计招待费用 earn(Worksheets(1).Cells(r, 2).Value) = earn(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 5).Value If Worksheets(1).Cells(r, 11).Value = "客户关系维护" Then cost(Worksheets(1).Cells(r, 2).Value) = cost(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 6).Value End If End If Else If Worksheets(1).Cells(r, 9).Value = "" And Worksheets(1).Cells(r, 8).Value = "" Then Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value Else Worksheets(1).Cells(r, 6).Value = Worksheets(1).Cells(r, 8).Value + Worksheets(1).Cells(r, 9).Value Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value End If If Worksheets(1).Cells(r, 2).Value "" Then earn(Worksheets(1).Cells(r, 2).Value) = earn(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 5).Value If Worksheets(1).Cells(r, 11).Value = "客户关系维护" Then cost(Worksheets(1).Cells(r, 2).Value) = cost(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 6).Value End If End If End If inner = inner + Worksheets(1).Cells(r, 5).Value outer = outer + Worksheets(1).Cells(r, 6).Value Else If Worksheets(1).Cells(r, 5).Value "" Then Worksheets(1).Cells(r, 9).Value = (Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 8).Value) * 0.08 Worksheets(1).Cells(r, 6).Value = Worksheets(1).Cells(r, 8).Value + Worksheets(1).Cells(r, 9).Value Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r - 1, 10).Value + Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value If Worksheets(1).Cells(r, 2).Value "" Then earn(Worksheets(1).Cells(r, 2).Value) = earn(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 5).Value If Worksheets(1).Cells(r, 11).Value = "客户关系维护" Then cost(Worksheets(1).Cells(r, 2).Value) = cost(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 6).Value End If End If Else If Worksheets(1).Cells(r, 9).Value = "" And Worksheets(1).Cells(r, 8).Value = "" Then Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r - 1, 10).Value + Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value Else Worksheets(1).Cells(r, 6).Value = Worksheets(1).Cells(r, 8).Value + Worksheets(1).Cells(r, 9).Value Worksheets(1).Cells(r, 10).Value = Worksheets(1).Cells(r - 1, 10).Value + Worksheets(1).Cells(r, 5).Value - Worksheets(1).Cells(r, 6).Value End If If Worksheets(1).Cells(r, 2).Value "" Then earn(Worksheets(1).Cells(r, 2).Value) = earn(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 5).Value If Worksheets(1).Cells(r, 11).Value = "客户关系维护" Then cost(Worksheets(1).Cells(r, 2).Value) = cost(Worksheets(1).Cells(r, 2).Value) + Worksheets(1).Cells(r, 6).Value End If End If End If inner = inner + Worksheets(1).Cells(r, 5).Value outer = outer + Worksheets(1).Cells(r, 6).Value End IfNext Cells(2, 14).Value = inner Cells(2, 15).Value = outer For s = 1 To 12//将统计的数据显示在选定的单元格上 Worksheets(1).Cells(s + 1, 18).Value = (cost(s) - (earn(s) * 0.001)) * 0.15 NextEnd Sub

这个程序有个小问题,因为我在做按月统计的时候把月份都列出来了,所以无形中将行数增加了,那么在算余额的时候用行数进行循环,会多出几个冗余的余额,但是当你的数据行数超过月份行数时就不会有这样的问题了 效果如图: 源码

版权声明:本文内容由互联网用户自发贡献,该文观点仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌抄袭侵权/违法违规的内容, 请发送邮件至lizi9903@foxmail.com举报,一经查实,本站将立刻删除。