|
在对固定资产审计时需要一份与TB账目相符的固定资产清单表,并且显示出全部的借贷方向等内容。
以下代码就是专门用来搞这个的。
你需要提取期初资产清单、期末资产清单、固定资产明细账(这些都可以在金蝶K/3系统中的固定资产模块找到。)
以下代码就能帮你搞定。
欢迎大师指点,谢谢!
- Sub 固定资产模板()
- Application.ScreenUpdating = False
- Dim ar, cr, dr
- Dim a, b, c, d, x, y, r, rx, ry, n, item
- Dim kw As New 数组
- Set bg原值 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set bg折旧 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set ed原值 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set ed折旧 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set dr原值 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set cr原值 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set dr折旧 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set cr折旧 = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set d = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set n = CreateObject("Scripting.Dictionary") '创建一个字典对象
- Set s = CreateObject("Scripting.Dictionary") '创建一个字典对象
- '期初清单
- Cells.Replace Chr(13), "": Cells.Replace Chr(10), ""
- Sheets("期初清单").Activate: ar = [a1].CurrentRegion
- 资产编码 = kw.所在列(ar, "资产编码", 1)
- 期初原值 = kw.所在列(ar, "原值本币", 1)
- 期初折旧 = kw.所在列(ar, "累计折旧", 1)
- For x = 1 To UBound(ar)
- If ar(x, 资产编码) <> "总计" And ar(x, 资产编码) <> "" Then
- bg原值("'" & ar(x, 资产编码)) = ar(x, 期初原值)
- bg折旧("'" & ar(x, 资产编码)) = ar(x, 期初折旧)
- If d.exists("'" & ar(x, 资产编码)) = False Then d("'" & ar(x, 资产编码)) = "1"
- End If
- Next x
- '期末清单
- Cells.Replace Chr(13), "": Cells.Replace Chr(10), ""
- Sheets("期末清单").Activate: ar = [a1].CurrentRegion
- 资产编码 = kw.所在列(ar, "资产编码", 1)
- 期末原值 = kw.所在列(ar, "原值本币", 1)
- 期末折旧 = kw.所在列(ar, "累计折旧", 1)
- For x = 1 To UBound(ar)
- If ar(x, 资产编码) <> "总计" And ar(x, 资产编码) <> "" Then
- ed原值("'" & ar(x, 资产编码)) = ar(x, 期末原值)
- ed折旧("'" & ar(x, 资产编码)) = ar(x, 期末折旧)
- If d.exists("'" & ar(x, 资产编码)) = False Then d("'" & ar(x, 资产编码)) = "1"
- End If
- Next x
- '固定资产明细账中提取 dr原值 ,cr原值,dr折旧
- Cells.Replace Chr(13), "": Cells.Replace Chr(10), ""
- Sheets("明细账").Activate: ar = [a1].CurrentRegion
- 资产编码 = kw.所在列(ar, "资产编码", 1)
- 原值借方 = kw.所在列(ar, "原值(综合本位币):借方金额", 1)
- 原值贷方 = kw.所在列(ar, "原值(综合本位币):贷方金额", 1)
- 折旧借方 = kw.所在列(ar, "累计折旧(综合本位币):借方金额", 1)
- For x = 1 To UBound(ar)
- If ar(x, 资产编码) <> "总计" And ar(x, 资产编码) <> "" Then
- dr原值("'" & ar(x, 资产编码)) = ar(x, 原值借方) + dr原值("'" & ar(x, 资产编码))
- cr原值("'" & ar(x, 资产编码)) = ar(x, 原值贷方) + cr原值("'" & ar(x, 资产编码))
- dr折旧("'" & ar(x, 资产编码)) = ar(x, 折旧借方) + dr折旧("'" & ar(x, 资产编码))
- If d.exists("'" & ar(x, 资产编码)) = False Then d("'" & ar(x, 资产编码)) = "1"
- End If
- Next x
- Sheets("总表").Activate: Sheets("总表").Cells.ClearContents
- [a1].Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)
- br = Range(Cells(1, 1), Cells(d.Count, 15))
- For x = 2 To UBound(br)
-
- br(x, 2) = bg原值("'" & br(x, 1))
- br(x, 3) = bg折旧("'" & br(x, 1))
- br(x, 4) = dr原值("'" & br(x, 1))
- br(x, 5) = cr原值("'" & br(x, 1))
- br(x, 6) = dr折旧("'" & br(x, 1))
- br(x, 7) = dr折旧("'" & br(x, 1)) + ed折旧("'" & br(x, 1)) - bg折旧("'" & br(x, 1))
- br(x, 8) = ed原值("'" & br(x, 1))
- br(x, 9) = ed折旧("'" & br(x, 1))
-
- Next x
- ' br(1, 7) = "折旧贷方"
- [b1].Resize(UBound(br), 9) = br
- [a1].Resize(1, 10) = Split("资产编码,资产编码,bg原值,bg折旧,dr原值,cr原值,dr折旧,cr折旧,ed原值,ed折旧", ",")
- c = Cells(Rows.Count, 1).End(xlUp).Row
- Range(Cells(c + 2, 3), Cells(c + 2, 10)).FormulaR1C1 = "=sum(r2c:r[-1]c)": Cells(c + 2, 2) = "total"
- 'Stop
- [k1].Resize(1, 8) = Split("资产名称,类别,入账日期,使用部门,存放地点,使用寿命,剩余寿命,管理者编", ",")
- rx = Cells(Rows.Count, 1).End(xlUp).Row
- ry = Cells(1, Columns.Count).End(xlToLeft).Column
- Range(Cells(2, "k"), Cells(rx, ry)).FormulaR1C1 = "=IFERROR(IFERROR(VLOOKUP(RC1,期末清单!C1:C32,MATCH(R1C,期末清单!R1,0),0),VLOOKUP(RC1,期初清单!C1:C32,MATCH(R1C,期初清单!R1,0),0)),"""")"
- ActiveWorkbook.Protect Structure:=True, Windows:=False
- 'ActiveWorkbook.Unprotect
- End Sub
复制代码
|
|