设为首页收藏本站|繁體中文

Excel 技巧网

 找回密码
 注册

QQ登录

只需一步,快速开始

手机号码,快捷登录

查看: 31037|回复: 94

[财会金融] 通过凭证明细,自动生成明细账及科目余额表

  [复制链接]
发表于 2010-5-7 09:42:19 | 显示全部楼层 |阅读模式
  • 署名作者: KevinChengCW
  • 版权声明: 版权归本站与作者共有 除本站官方外非作者本人转载须经许可并注明出处
  • 本文来自:
  • 引用作品: http://www.exceltip.net/thread-7340-1-1-21112.html
  • 适用版本: 2007 2003以前版本 
  • 语言环境: 简体中文
  • 学习方法: 掌握Excel技巧的关键是动手操作 | 下载 ≠ 知识


  • 免费注册成为本站会员,享用更多功能,结识更多Office办公高手!

    您需要 登录 才可以下载或查看,没有帐号?注册

    x
    本帖最后由 kevinchengcw 于 2010-5-25 14:23 编辑

    一个通过凭证记录可以自动生成明细账和科目余额表的工作簿,对明细账支持个别生成及批量生成:

    个别生成代码如下:
    1. Sub 个别生成()
    2. Dim M, N, I, T As Integer
    3. N = 5
    4. With ActiveSheet
    5.     If .Name = "个别生成页" And .Range("d2") = "" Then  '判断编码是否已输入
    6.          '如果为空,则选中该单元格,并显示提示对话框,然后退出处理
    7.         .Range("d2").Select  
    8.         MsgBox "请先输入编码", vbOKOnly, "错误"
    9.         Exit Sub
    10.     End If
    11.     .Rows("5:65536").Delete      '清空数据区以便写入新数据
    12. End With
    13. Application.ScreenUpdating = False  '关闭屏幕刷新以提高速度
    14. With Worksheets("凭证明细表")    '以下为写入过程
    15.     ActiveSheet.Cells(N, 5) = "期初金额"    'E列的当前行的文本为“期初金额”
    16.     ActiveSheet.Cells(N, 9) = WorksheetFunction.VLookup(ActiveSheet.Cells(2, 4).Value, Worksheets("期初余额").UsedRange, 3, 0)   '在期初余额表中查询对应的数值并写入I列当前行
    17.     N = N + 1  '下移一行
    18.     T = 2   '预设凭证明细表操作起始行,主要用于判断年份是否跨越
    19.     For M = 2 To .Cells(Rows.Count, 1).End(3).Row  '循环提取凭证明细表的数据区各行数据
    20.         If .Cells(M, 1).Value = ActiveSheet.Cells(2, 4).Value Then   '如果单元格的值与生成的明细账表的当前科目编码一致,则执行下述操作
    21.             If ActiveSheet.Cells(3, 2) <> "" Then   '判断是否预设了要提取的年份,如果是(即明细账表中的"B3"单元格的值不为空),则执行下述操作
    22.                 If .Cells(M, 5).Value = ActiveSheet.Cells(3, 2).Value Then   '如果凭证明细表中当前循环的行的E列的值与预设年份一致,则执行下述操作
    23.                     For I = 2 To 7  '循环赋值凭证明细表中当前行的B列到G列的值到生成的明细表中当前行
    24.                         ActiveSheet.Cells(N, I) = .Cells(M, I + 4)
    25.                     Next I
    26.                     With ActiveSheet  ’在明细账表中再进行下述计算(计算余额)
    27.                         If .Cells(N - 1, 9) = "" Then   '如果上一行的I列为空,则
    28.                             .Cells(N, 9) = .Cells(N - 2, 9) + .Cells(N, 6) - .Cells(N, 7)  '当前行的I列的值等于I列当前行的上两行的值加上本行F列的值减去G列的值(此情况仅在跨年份的时候会出现,因为到时会插入一个跨年标志行)
    29.                         Else  '如果上一行的I列不为空,则
    30.                             .Cells(N, 9) = .Cells(N - 1, 9) + .Cells(N, 6) - .Cells(N, 7)  '当前行的I列的值等于I列当前行的上一行的值加上本行F列的值减去G列的值
    31.                         End If
    32.                     End With
    33.                     N = N + 1  '下移一行
    34.                 End If
    35.             Else   '如果未预设要提取的年份,则执行提取全部该科目名称的数据的操作
    36.                 If .Cells(T, 5) <> .Cells(M, 5) And .Cells(T, 5) <> "" Then    '如果当前行的年份与初始年份不同,则
    37.                     ActiveSheet.Range(ActiveSheet.Cells(N, 2), ActiveSheet.Cells(N, 9)).Interior.Color = vbRed   '在生成的明细账表中插入一个跨年标志行,设置成红色底色
    38.                     ActiveSheet.Cells(N, 5) = .Cells(M, 5).Value & "期初金额"    '标志行文字设为凭证明细表当前行的年份值
    39.                     N = N + 1   '插入完标志行后下移一行
    40.                 End If
    41.                 For I = 2 To 7   '向明细账表写入凭证明细表B列到G列的内容
    42.                     ActiveSheet.Cells(N, I) = .Cells(M, I + 4)
    43.                 Next I
    44.                 With ActiveSheet   '计算余额,方法同上
    45.                         If .Cells(N - 1, 9) = "" Then
    46.                             .Cells(N, 9) = .Cells(N - 2, 9) + .Cells(N, 6) - .Cells(N, 7)
    47.                         Else
    48.                             .Cells(N, 9) = .Cells(N - 1, 9) + .Cells(N, 6) - .Cells(N, 7)
    49.                         End If
    50.                 End With
    51.                 N = N + 1  '下移一行
    52.                 T = M  '将新的年份据在行的值赋值给T
    53.             End If
    54.         End If
    55.     Next M
    56. End With
    57. With ActiveSheet   '以下为插入年和月份汇总的代码,N值为从上一代码段延续过来的
    58.     M = .Cells(Rows.Count, 2).End(3).Row    '判断B列数据行的最末行数
    59.     Do While N >= 6 Or N = M   '当N值处于数据区内时执行循环操作
    60.         If M = N Or (Cells(N, 2) <> Cells(N + 1, 2) And Cells(N, 2).Interior.Color <> vbRed) Then  '当处于最末行时或与B列下一行数据不一致时(即月份不同时)或单元格颜色为红色时(即处于跨年标志行上时)执行下述操作
    61.             .Rows(N + 1 & ":" & N + 2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove   '向当前行下部插入两行,并复制上方或左侧单元格格式
    62.             .Range(.Cells(N + 1, 2), .Cells(N + 2, 9)).Interior.Color = vbYellow    '将插入的两行单元格的底色设置为黄色
    63.             I = WorksheetFunction.CountIf(.Range(.Cells(N, 2), .Cells(6, 2)), .Cells(N, 2))    '判断当前单元格至数据顶部B列相同日期的行数并赋值给变量I
    64.             .Cells(N + 1, 5) = "本月累计"   '插入行的上面行E列文本为“本月累计”
    65.             .Cells(N + 1, 6) = WorksheetFunction.Sum(.Range(.Cells(N, 6), .Cells(N - I + 1, 6)))    '将判断得到的行数数值加和
    66.             .Cells(N + 1, 7) = WorksheetFunction.Sum(.Range(.Cells(N, 7), .Cells(N - I + 1, 7)))
    67.             .Cells(N + 1, 9) = .Cells(N, 9)
    68.             .Cells(N + 2, 5) = "本年累计"   '插入行的下面行E列文本为“本年累计”
    69.             .Cells(N + 2, 6) = WorksheetFunction.Sum(.Range(.Cells(N, 6), .Cells(6, 6)))    '将判断得到的行数数值加和
    70.             .Cells(N + 2, 7) = WorksheetFunction.Sum(.Range(.Cells(N, 7), .Cells(6, 7)))
    71.             .Cells(N + 2, 9) = .Cells(N, 9)
    72.         End If
    73.         N = N - 1    '上移一行
    74.     Loop
    75. End With
    76. Application.ScreenUpdating = True
    77. End Sub
    复制代码
    批量写入代码如下:
    1. Sub 批量生成()
    2. Dim Ws As Worksheet
    3. Worksheets("模板").Visible = xlSheetVisible   '取消模板的隐藏
    4. Application.DisplayAlerts = False   '因为要删除旧有的表所以要关闭提示
    5. For Each Ws In ThisWorkbook.Worksheets  '枚举工作表,删除以前生成的工作表
    6.     If Ws.Name <> "凭证明细表" And Ws.Name <> "批量操作页" And Ws.Name <> "期初余额" And Ws.Name <> "模板" And Ws.Name <> "个别生成页" Then Ws.Delete
    7. Next Ws
    8. Application.DisplayAlerts = True
    9. With Worksheets("期初余额")    '以下是批量生成过程,调用个别生成的代码完成
    10.     For N = 1 To .Cells(Rows.Count, 1).End(3).Row   '循环期初余额表中的数据行,生成对应科目的明细账表
    11.         Worksheets("个别生成页").Copy before:=Worksheets(1)   '复制个别生成页到工作表标签的最前面
    12.         Worksheets(1).[d2] = Worksheets("期初余额").Cells(N, 1).Value    '写入科目编码
    13.         Worksheets(1).Name = Worksheets("期初余额").Cells(N, 1).Value  '以科目编码命名该工作表
    14.         Worksheets(1).Activate
    15.         个别生成   '调用个别生成的代码
    16.     Next N
    17. End With
    18. Worksheets("模板").Visible = xlSheetVeryHidden  '完成后将模板隐藏
    19. End Sub
    复制代码
    生成的明细帐样式

    通过凭证明细,自动生成明细账及科目余额表

    通过凭证明细,自动生成明细账及科目余额表


    生成科目余额表代码如下:
    1. Public mDate As Date  '定义用于传递输入日期的公共变量

    2. Sub 生成科目余额表()
    3. Dim Ws As Worksheet
    4. msg = MsgBox("该操作将删除旧的科目余额表,确认操作?" & vbnew & "是: 继续执行" & vbNewLine & "否: 退出操作", vbYesNo, "提示")  '询问是否确认删除已有科目表
    5. If msg = vbNo Then Exit Sub
    6. Application.ScreenUpdating = False
    7. For Each Ws In ThisWorkbook.Worksheets
    8. If Ws.Name = "科目余额表" Then  '查找旧的科目余额表并删除
    9. Application.DisplayAlerts = False
    10. Ws.Delete
    11. Application.DisplayAlerts = True
    12. End If
    13. Next Ws
    14. Application.ScreenUpdating = True
    15. UserForm1.Show   '显示日期输入窗体
    16. End Sub

    17. Sub 科目余额表()  '正式生成科目余额表的代码
    18. Dim Ws, Form As Worksheet
    19. Dim M, N, I  As Integer
    20. Dim Begin, mTotal1, mTotal2, yTotal1, yTotal2, Total1, Total2 As Double
    21. 'MsgBox mDate
    22. Application.ScreenUpdating = False
    23. Worksheets("科目余额表模板").Visible = xlSheetVisible   '将模板取消隐藏并复制,如果改为用代码生成表头的话可以不用模板
    24. Worksheets("科目余额表模板").Copy before:=Worksheets(1)
    25. Set Form = Worksheets(1)
    26. Form.Name = "科目余额表"
    27. Form.Move before:=Worksheets(1)
    28. With Form
    29.     .[c1] = Year(mDate)  '输入选定的日期
    30.     .[d1] = Month(mDate)
    31.     .[e1] = Day(mDate)
    32.     N = 3
    33.     For M = 1 To Worksheets("期初余额").Cells(Rows.Count, 1).End(3).Row
    34.         '初始化各项目开始累积值
    35.         mTotal1 = 0     '本月借方累计
    36.         mTotal2 = 0     '本月贷方累计
    37.         yTotal1 = 0     '本年借方累计
    38.         yTotal2 = 0     '本年贷方累计
    39.         Total1 = 0     '借方总累计
    40.         Total2 = 0     '贷方总累计
    41.         .Cells(N, 1) = Worksheets("期初余额").Cells(M, 1)   '写入科目代码、名称及截止日期
    42.         .Cells(N, 2) = Worksheets("期初余额").Cells(M, 2)
    43.         .Cells(N, 3) = .[c1]
    44.         .Cells(N, 4) = .[d1]
    45.         .Cells(N, 5) = .[e1]
    46.         Begin = Worksheets("期初余额").Cells(M, 3)   '设定期初金额
    47.         For I = 2 To Worksheets("凭证明细表").Cells(Rows.Count, 1).End(3).Row   '循环累计各项
    48.             If Worksheets("凭证明细表").Cells(I, 1) = .Cells(N, 1) Then  '判断凭证明细表当前单元格内容是否与科目余额表当前单元格内容一致
    49.                 If DateValue(Worksheets("凭证明细表").Cells(I, 5).Value & "-" & Worksheets("凭证明细表").Cells(I, 6).Value & "-" & Worksheets("凭证明细表").Cells(I, 7).Value) < DateValue(Year(mDate) & "-" & Month(mDate) & "-1") Then  '判断是否当前日期为输入日期的上个月(含)之前的内容
    50.                     Begin = Begin + Worksheets("凭证明细表").Cells(I, 10).Value - Worksheets("凭证明细表").Cells(I, 11).Value   
    51.                 End If
    52.                 If DateValue(Worksheets("凭证明细表").Cells(I, 5).Value & "-" & Worksheets("凭证明细表").Cells(I, 6).Value & "-" & Worksheets("凭证明细表").Cells(I, 7).Value) <= mDate Then  '判断当前日期是否是输入日期之前的内容
    53.                     Total1 = Total1 + Worksheets("凭证明细表").Cells(I, 10)
    54.                     Total2 = Total2 + Worksheets("凭证明细表").Cells(I, 11)
    55.                 End If
    56.                 If Worksheets("凭证明细表").Cells(I, 5).Value = Year(mDate) Then  '判断当前日期是否是输入日期当年的内容
    57.                     If DateValue(Worksheets("凭证明细表").Cells(I, 5).Value & "-" & Worksheets("凭证明细表").Cells(I, 6).Value & "-" & Worksheets("凭证明细表").Cells(I, 7).Value) <= mDate Then  '继续判断是否是输入日期之前的内容
    58.                         yTotal1 = yTotal1 + Worksheets("凭证明细表").Cells(I, 10).Value
    59.                         yTotal2 = yTotal2 + Worksheets("凭证明细表").Cells(I, 11).Value
    60.                     End If
    61.                     If Worksheets("凭证明细表").Cells(I, 6).Value = Month(mDate) And Worksheets("凭证明细表").Cells(I, 7).Value <= Day(mDate) Then  '继续判断是否是输入日期当月并且是当日之前的内容
    62.                         mTotal1 = mTotal1 + Worksheets("凭证明细表").Cells(I, 10).Value
    63.                         mTotal2 = mTotal2 + Worksheets("凭证明细表").Cells(I, 11).Value
    64.                     End If
    65.                 End If
    66.             End If
    67.         Next I
    68.         .Cells(N, 6) = Begin   '写入累计结果
    69.         .Cells(N, 7) = mTotal1
    70.         .Cells(N, 8) = mTotal2
    71.         .Cells(N, 9) = yTotal1
    72.         .Cells(N, 10) = yTotal2
    73.         .Cells(N, 11) = Total1
    74.         .Cells(N, 12) = Total2
    75.         .Cells(N, 13) = Worksheets("期初余额").Cells(M, 3) + Total1 - Total2
    76.         N = N + 1
    77.     Next M
    78.     .Columns("F:M").NumberFormatLocal = "0.00"   '设置对应区域数值格式
    79.     .Range(Cells(2, 1), Cells(N - 1, 13)).Borders.LineStyle = 1   '数据区域加上网格线
    80. End With
    81. Worksheets("科目余额表模板").Visible = xlSheetVeryHidden   '隐藏模板
    82. Application.ScreenUpdating = True
    83. End Sub
    复制代码
    生成效果如下图:

    通过凭证明细,自动生成明细账及科目余额表

    通过凭证明细,自动生成明细账及科目余额表


    详见附件。

    通过凭证明细,自动生成明细账及科目余额表.rar

    42.34 KB, 下载次数: 1223, 下载积分: 消费券 -5 Ti币

    通过凭证明细,自动生成明细账及科目余额表

    发表于 2010-5-9 12:06:17 | 显示全部楼层
    很有意思。谢谢
    回复 支持 反对

    使用道具 举报

    发表于 2010-6-10 13:37:38 | 显示全部楼层
    为什么我下载后打开,显示的是:编译错误:找不到工程或库

    菜鸟级别,请高手解释一下:)
    回复 支持 反对

    使用道具 举报

    发表于 2010-6-11 07:11:55 | 显示全部楼层
    本帖最后由 xing768 于 2010-6-11 07:14 编辑

    谢谢了!为什么点击  批量生成    显示错误啊?批量生成和个别生成是什么意思?不好意思问这么简单的问题。
    回复 支持 反对

    使用道具 举报

    发表于 2010-8-1 17:49:30 | 显示全部楼层
    好东东大家分享,谢谢提供
    回复 支持 反对

    使用道具 举报

    发表于 2010-9-14 10:30:39 | 显示全部楼层
    好东东大家分享,谢谢提供
    回复 支持 反对

    使用道具 举报

    发表于 2010-9-14 10:32:55 | 显示全部楼层
    为啥链接不能用哦
    回复 支持 反对

    使用道具 举报

    发表于 2010-10-4 09:07:01 | 显示全部楼层
    是否根据记账凭证直接输入凭证明细表就可以了?历年借方累计历年贷方累计是怎样来的?有需要结转的怎样实现
    回复 支持 反对

    使用道具 举报

    发表于 2010-10-8 15:32:38 | 显示全部楼层
    哦,好好学习,这些代码要研究一阵了
    回复 支持 反对

    使用道具 举报

    发表于 2010-10-13 16:05:15 | 显示全部楼层
    学习!
    回复 支持 反对

    使用道具 举报

    您需要登录后才可以回帖 登录 | 注册

    本版积分规则

    关闭

    站长推荐上一条 /1 下一条

    Excel技巧网的会员探讨问题仅代表其个人意见,与网站的立场无关。任何违反国家和地方相关法律法规的言论,本站有义务协助政府相关部门追究发言者的责任!
    本站中非注明转载文章与案例的版权为作者与Excel技巧网共有。若非原文作者,本站之外任何单位或个人未经允许,不得将其用于商业用途。
    若非原文作者,任何形式的非商业性转载必须获得Excel技巧网或作者允许,并注明作者和出处。
    会员发表的帖子如涉及版权纠纷,须自行负责。详情请参考注册时的网站服务条款。
    本站特聘法律顾问:沈学律师

    Archiver|手机版|Excel技巧网 ( 闽ICP备08107682号-2 ) | 闽公网安备 35020302032608号  

    GMT+8, 2018-9-22 07:26

    Powered by Discuz! X3.3

    © 2001-2017 Comsenz Inc.

    快速回复 返回顶部 返回列表