Excel实现明细帐的示例

myerp · 发表于 2005-8-11 21:40

谢谢!

ee0606 · 发表于 2005-8-18 04:01

yfxpzq · 发表于 2005-11-16 20:14

谁能写一个13栏明细帐的模板,绝对N多个人会去下载,估计没有吧?????[em08]

lism75 · 发表于 2005-12-14 12:28

haohaoyanjiu

zbs112 · 发表于 2005-12-14 15:00

相当不错，谢谢楼主！

XUDAN511 · 发表于 2005-12-15 09:14

感觉好深，看不懂，不过是这种方向

cntax · 发表于 2006-1-1 20:37

以下是引用[I]hzg7818[/I]在2004-2-25 18:35:00的发言：[BR]这个示例仅仅说明从财务软件取数生成账簿的方法，实际很多财务软件也是这样做的，采用Ado或Dao等数据访问组件，从后台数据库提取数据，然后生成所需格式的报表等等，由于仅仅是个示例，离实际应用需要丰富和完善的功能还相差很多，如果大家需要在实际工作中应用的话，必须先掌握一定的Sql语句、ado对象的使用方法，不过这些也都是必须使用vba的，当然vba的语法方面也需过关，如果这些方法不会没关系，可以多看微软自带的帮助示例代码，相信很快就可以掌握的。

使用Excel的数据透视表等工具也可以实现明细帐，在这个方面深入研究的确是掌握Excel的绝佳方式，但财务软件都是基于数据库的，要将Excel与财务软件结合在一起使用，使用Ado和Sql语句是必经之路，各位财会同仁如果对Ado等没有过接触的，不妨在这方面下一些功夫。

由于Excel天然的所见即所得的功能以及Ado良好的适应性，这两个工具结合使用会胜过很多财务软件的报表、账簿打印模块，相信大家都可以做的到！

附：ado的帮助文件ado210.chm，jet引擎的sql帮助文件Jetsql.chm，这两个文件安装完全的office一般都带，各位需要的朋友自己搜索一下。

PFPF!五体投地
[em17]

caoyue96 · 发表于 2006-1-4 22:26

年初借用了龙逸凡的账务处理记账,但由于是用Excel做的,数据多了速度很慢(凭证分录有10000多行),虽然能查阅各类账目,但没有明细账页的打印（根椐手工记账的规定需要账页）,现已到了年底,所有的明细账都没有记,真是急死了,看了版主的明细账实例,真是佩服,不知版主能否帮忙。原来是用Excel的后来想学习版主的的方法就导出到了Access数据库,但对于版主的宏命令无法参悟,所以无法自己完成。希望版主帮忙，先在此谢过了。

TyC77BnJ.rar (69.33 KB, 下载次数: 148)

lihua_jian · 发表于 2006-1-5 15:30

说的都是精华。有必要进一步学习。

glober609 · 发表于 2006-1-24 11:33

前一段时间完成了应收账款明细账查询，前提是所有数据都在excel中，用excel做数据库，缺点：速度太慢
Sub LookupAR() Dim FinalRow As Integer Dim FinalColumn As Integer Dim DataBase As Range Dim FlagRange As Range Dim MonthRange As Range Dim AimRange As Range Dim CriteriaRange As Range Dim ORange As Range Dim StartTime Dim FinishTime
Application.ScreenUpdating = False StartTime = Timer
'假定明细帐最多2000行
 Range(Cells(7, 1), Cells(2006, 20)).Delete Range("i1:iv1").EntireColumn.Delete FinalColumn = Range("iv4").End(xlToLeft).Column Debug.Print FinalColumn Cells(6, 4) = "上年结转" Cells(6, 8).Formula = "=if(iserror(VLOOKUP(C2,BeginningAmount,2,FALSE)),0,VLOOKUP(C2,BeginningAmount,2,FALSE))" Cells(6, 8) = Cells(6, 8).Value With Worksheets("凭证录入")
Cells(1, FinalColumn + 3).Resize(1, 5) = Array(.Cells(4, 3), .Cells(4, 4), .Cells(4, 5), .Cells(4, 8), .Cells(4, 9))
End With
Set ORange = Cells(1, FinalColumn + 3).Resize(1, 5)
Range("pzlr").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _ "ARCriteria"), CopyToRange:=ORange, Unique:=False ORange.EntireColumn.Select Selection.Columns.AutoFit Selection.Font.Size = 9
'设计本月合计、累计
Dim AimRow As Integer Dim FlagRow As Integer Dim FlagColumn As Integer Dim TotalCreditMonth As Currency Dim TotalDebitMonth As Currency Dim TotalCreditYear As Currency Dim TotalDebitYear As Currency AimRow = 7: FlagRow = 2: FlagColumn = 11 Do While Cells(FlagRow, FlagColumn) <> "" TotalDebitYear = TotalDebitYear + Cells(FlagRow, FlagColumn + 3) TotalCreditYear = TotalCreditYear + Cells(FlagRow, FlagColumn + 4) If Cells(FlagRow + 1, FlagColumn) <> "" And Month(Cells(FlagRow, FlagColumn)) <> Month(Cells(FlagRow + 1, FlagColumn)) Then Cells(AimRow, 1) = Month(Cells(FlagRow, FlagColumn)) Cells(AimRow, 2) = Day(Cells(FlagRow, FlagColumn)) Cells(FlagRow, FlagColumn + 1).Resize(1, 4).Copy Destination:=Cells(AimRow, 3) Cells(AimRow + 1, 3) = "本月合计" Cells(AimRow + 2, 3) = "累计" If Cells(AimRow + 1, 3) = "本月合计" Then Cells(AimRow + 1, 5) = Cells(FlagRow, FlagColumn + 3) + TotalDebitMonth Cells(AimRow + 1, 6) = Cells(FlagRow, FlagColumn + 4) + TotalCreditMonth TotalDebitMonth = 0: TotalCreditMonth = 0 Cells(AimRow + 2, 5) = TotalDebitYear Cells(AimRow + 2, 6) = TotalCreditYear End If AimRow = AimRow + 2 Else Cells(AimRow, 1) = Month(Cells(FlagRow, FlagColumn)) Cells(AimRow, 2) = Day(Cells(FlagRow, FlagColumn)) Cells(FlagRow, FlagColumn + 1).Resize(1, 4).Copy Destination:=Cells(AimRow, 3) TotalCreditMonth = TotalCreditMonth + Cells(FlagRow, FlagColumn + 4) TotalDebitMonth = TotalDebitMonth + Cells(FlagRow, FlagColumn + 3) End If AimRow = AimRow + 1 FlagRow = FlagRow + 1 Loop Cells(AimRow, 3) = "本月合计" Cells(AimRow + 1, 3) = "累计" Cells(AimRow, 5) = TotalDebitMonth Cells(AimRow, 6) = TotalCreditMonth Cells(AimRow + 1, 5) = TotalDebitYear Cells(AimRow + 1, 6) = TotalCreditYear Range("a6").Select FinalRow = [c65536].End(xlUp).Row Set region = Range("a6").Resize(FinalRow - 5, 8) irow = 7 Do While Cells(irow, 3) <> "" If Cells(irow, 3) = "本月合计" Or Cells(irow, 3) = "累计" Then Cells(irow, 8).Value = Cells(irow - 1, 8) Else Cells(irow, 8).Value = Cells(irow - 1, 8) + Cells(irow, 5) - Cells(irow, 6) End If If Cells(irow, 8).Value > 0 Then Cells(irow, 7) = "借" Else If Cells(irow, 8).Value = 0 Then Cells(irow, 7) = "平" Else Cells(irow, 7) = "贷" End If End If irow = irow + 1 Loop region.RowHeight = 15 With region .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With region.Borders(xlDiagonalDown).LineStyle = xlNone region.Borders(xlDiagonalUp).LineStyle = xlNone With region.Borders(xlEdgeLeft) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With region.Borders(xlEdgeTop) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With region.Borders(xlEdgeBottom) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With region.Borders(xlEdgeRight) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With region.Borders(xlInsideVertical) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With With region.Borders(xlInsideHorizontal) .LineStyle = xlContinuous .Weight = xlThin .ColorIndex = 5 End With '返回程序运行时间 FinishTime = Timer MsgBox "应收账款----" & Cells(2, 3).Value & Chr(13) & Chr(10) & "明细帐查询共用了：" & Chr(13) & Chr(10) & FinishTime - StartTime & "秒" Application.ScreenUpdating = True
region.Columns("h").NumberFormatLocal = "#,##0.00_ " Range("k1:iv1").EntireColumn.Delete End Sub

		自动登录	找回密码
密码			免费注册

[分享] Excel实现明细帐的示例

请教版主