Excel现金日记账合计行的实现（VBA）

1、Excel现金日记账合计行的实现（VBA）用Excel处理现金日记账仅靠Excel本身内置的公式明显不足；若用Excel的汇总功能一样不便。解决该问题的较好方法是使用VBA来处理。以下是我编写的VBA代码（若要与该代码配合使用的“现金日记账”工作簿，请发文至hyp500索取，但本人不一定能及时给予回复；或者您可凭此链接Option ExplicitPrivate Sub ConformButton1_Click()    Dim Row As Integer, Column As Integer, i As Integer '定义行号、列标及循环所用的变量

2、    Dim RowData() As Variant '定义一动态数组存放数据区行数据    Dim RiQiColumn As Integer, ZhaiYaoColumn As Integer, JieFangColumn As Integer, DaiFangColumn As Integer    Dim JieFangHeJi As Double, DaiFangHeJi As Double '定义借方合计、贷方合计的累加器变量    Dim S

3、umDataRow As Integer '定义待统计数据的行数    Dim SumDay As Double, SumMonth As Double, SumYear As Double '定义待统计的具体日期、月份和年份的变量    Dim OldSelection As Object '定义用户操作状态的变量    Set OldSelection = Selection    '    '判断活动

4、单元格是否处于合理的范围内    '    If Union(Range("data"), Selection).Address <> Range("data").Address _    Or IsEmpty(Cells(ActiveCell.Row - 1, Range("日期").Column) Then '“data”是表格中已定义的代表数据区的变量     &

5、#160;  MsgBox "请将活动单元格置于账页内待合计行处。"        Unload UserForm1        OldSelection.Select        Exit Sub    End If    '    '判断数据区中

6、的活动单元格所在行的数据区单元格是否有内容    '    Row = ActiveCell.Row '确定有效行号    Column = Range("余额").Column - 2  '确定有效列标，减2是最后两栏不用考虑    ReDim RowData(1 To 1, 1 To Column)    RowData = Range(Cells(Row, 1), Cells(Row,

7、Column)    For i = 1 To Column        If Not IsEmpty(RowData(1, i) Then            Unload UserForm1            MsgBox "本行非空，请确认后再进行合计。&

8、quot;            OldSelection.Select            Exit Sub        End If    Next i    '    '确定“日期”、“摘要”、

9、“借方”和“贷方”各栏所在列标    '    RiQiColumn = Range("日期").Column: ZhaiYaoColumn = Range("摘要").Column    JieFangColumn = Range("借方").Column: DaiFangColumn = Range("贷方").Column    '    

10、9;确定待统计数据区行数    '    SumDataRow = Row - Range("StartCell").Row '“StartCell”是表格中已定义的代表某一单元格的变量    '    '确定待统计具体日期    '    SumDay = Cells(ActiveCell.Row - 1, RiQiColumn).Value &

11、#160;  '    '确定待统计日期的月份和年份    '    SumMonth = Month(SumDay)    SumYear = Year(SumDay)    '    '累加器赋初值    '    JieFangHeJi = 0    DaiFang

12、HeJi = 0    '    '开始合计    '   Application.ScreenUpdating = False    '    If OptionDay Then '本日合计        For i = 1 To SumDataRow     

13、60;      '            '判断之前是否已做过同样日期的日合计或者是否有待合计的日合计数据            '            If Cells(Row - i, R

14、iQiColumn).Value = SumDay Then                If Cells(Row - i, ZhaiYaoColumn).Value = "本日合计" _                Or Cells(Row - i, ZhaiYaoColu

15、mn).Value = "本月合计" _                Or Cells(Row - i, ZhaiYaoColumn).Value = "本年累计" _                Or Cells(Row - i, ZhaiYaoColu

16、mn).Value = "全年合计" Then                    MsgBox "日合计已结或者无日合计数据，请确认后重新操作。"                  &#

17、160; OptionDay.SetFocus                    Exit Sub                End If         

18、60;  End If            '            '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '      

19、60;     If Cells(Row - i, RiQiColumn).Value <> SumDay Then Exit For            '        Next i        '      &#

20、160; '开始本日合计        '        Cells(Row, RiQiColumn) = Cells(Row - 1, RiQiColumn)        Cells(Row, ZhaiYaoColumn) = "本日合计"        For i = 1 To

21、 SumDataRow            If Cells(Row - i, RiQiColumn).Value = SumDay Then                JieFangHeJi = JieFangHeJi + Cells(Row - i, JieFangColumn).Value   &

22、#160;            DaiFangHeJi = DaiFangHeJi + Cells(Row - i, DaiFangColumn).Value            End If            '   &#

23、160;        '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '            If Cells(Row - i, RiQiColumn).Value <> SumDay Then Exit For  

24、60;     Next i        '    ElseIf OptionMonth Then '本月合计        '        '判断之前是否已做过同样月份的月合计        ' 

25、;       For i = 1 To SumDataRow            If Year(Cells(Row - i, RiQiColumn).Value) = SumYear Then                If Month(Cells(Row - i, R

26、iQiColumn).Value) = SumMonth Then                    If Cells(Row - i, ZhaiYaoColumn).Value = "本月合计" _               

27、60;    Or Cells(Row - i, ZhaiYaoColumn).Value = "全年合计" Then                        MsgBox "无月合计数据，请确认后重新操作。"       

28、                 OptionMonth.SetFocus                        Exit Sub      

29、              End If                End If            End If       

30、60;    '            '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '            If Month(Cells(Row - i, RiQiColum

31、n).Value) <> SumMonth Then Exit For            If Year(Cells(Row - i, RiQiColumn).Value) <> SumYear Then Exit For        Next i        '    

32、;    '开始本月合计        '        Cells(Row, RiQiColumn) = DateSerial(SumYear, SumMonth + 1, 0)        Cells(Row, ZhaiYaoColumn) = "本月合计"     

33、   For i = 1 To SumDataRow            If Year(Cells(Row - i, RiQiColumn).Value) = SumYear Then                If Month(Cells(Row - i, RiQiColumn).Value) = SumMo

34、nth Then                    If Cells(Row - i, ZhaiYaoColumn).Value <> "本日合计" Then                  

35、      JieFangHeJi = JieFangHeJi + Cells(Row - i, JieFangColumn).Value                        DaiFangHeJi = DaiFangHeJi + Cells(Row - i, DaiFangColumn).Value

36、0;                   End If                End If            End If  &

37、#160;         '            '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '            I

38、f Month(Cells(Row - i, RiQiColumn).Value) <> SumMonth Then Exit For            If Year(Cells(Row - i, RiQiColumn).Value) <> SumYear Then Exit For        Next i    '  

39、60; Else '本年累计或合计        '        '判断之前是否已做过全年合计        '        For i = 1 To SumDataRow         &#

40、160;  If Year(Cells(Row - i, RiQiColumn).Value) = SumYear Then                If Cells(Row - i, ZhaiYaoColumn).Value = "全年合计" Then             &#

41、160;      MsgBox "无年累计或年合计数据，请确认后重新操作。"                    If OptionYearNow Then               

42、         OptionYearNow.SetFocus                    Else                  &#

43、160;     OptionYearAll.SetFocus                    End If                    Exit Sub 

44、;               End If            End If            '          

45、60; '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '            If Year(Cells(Row - i, RiQiColumn).Value) <> SumYear Then Exit For        Next i&#

46、160;       '        If OptionYearNow Then            Cells(Row, RiQiColumn) = Cells(Row - 1, RiQiColumn)            Cells

47、(Row, ZhaiYaoColumn) = "本年累计"        Else            Cells(Row, RiQiColumn) = DateSerial(SumYear, 12, 31)            Cells(Row, ZhaiYaoColumn) =

48、"全年合计"        End If        For i = 1 To SumDataRow            If Year(Cells(Row - i, RiQiColumn).Value) = SumYear Then       

49、0;        If Cells(Row - i, ZhaiYaoColumn).Value <> "全年合计" Then                    If Cells(Row - i, ZhaiYaoColumn).Value <> "本年累计" Then&#

50、160;                       If Cells(Row - i, ZhaiYaoColumn).Value <> "本月合计" Then               

51、0;            If Cells(Row - i, ZhaiYaoColumn).Value <> "本日合计" Then                           

52、     JieFangHeJi = JieFangHeJi + Cells(Row - i, JieFangColumn).Value                                DaiFangHeJi = DaiFangHeJi

53、 + Cells(Row - i, DaiFangColumn).Value                            End If               

54、60;        End If                    End If                End If     

55、       End If            '            '如果当前行“日期”栏值已不是待合计的日期值，则立即中止循环            '  

56、          If Year(Cells(Row - i, RiQiColumn).Value) <> SumYear Then Exit For        Next i    End If    If JieFangHeJi <> 0 Then Cells(Row, JieFangColumn).Value = JieFangHeJi    If DaiFangHeJi <> 0 Then Cells(Row, DaiFangColumn).Value = DaiFangHeJi    '    '为合计行添加红色底线    '    If Cells(Row, ZhaiYaoColumn).Value <> "全年合计" Then   &