「代码」财务审计业务，往来科目重分类，数组、字典综合应用
文摘
教育
2024-11-07 23:11
江苏
1、在工作表“发生额”里，命令按钮点击事件，调用重分类过程：
Private Sub CmdReClassify_Click() changeSubject = False Call reClassifyEnd Sub
Private Sub CmdReClassify2_Click() changeSubject = True Call reClassifyEnd Sub
2、在模块myModule里，reClassify重分类过程：
第一部分，定义变量，把对照表装入字典dicSubjects，处理科目余额数据，装入字典dic：
Public changeSubject As Boolean
Sub reClassify() Dim i As Integer Dim ws As Worksheet, rng As Range Dim lRow As Integer, lCol As Integer Dim arr() Dim dicSubjects As Object '//用于重分类科目对应 Dim subject1 As String, subject2 As String, direction1 As String, direction2 As String Dim key1, key2 Dim dic As Object Dim balance As Double Dim customerORsupplier As String Set dicSubjects = CreateObject("Scripting.Dictionary") Set dic = CreateObject("Scripting.Dictionary") Set ws = ThisWorkbook.Sheets("对照表") With ws lRow = .UsedRange.Rows.Count For i = 2 To lRow subject1 = .Cells(i, 1): subject2 = .Cells(i, 3) direction1 = .Cells(i, 2): direction2 = .Cells(i, 4) Set dicSubjects(subject1) = CreateObject("Scripting.Dictionary") Set dicSubjects(subject2) = CreateObject("Scripting.Dictionary") dicSubjects(subject1)("方向") = direction1 dicSubjects(subject2)("方向") = direction2 dicSubjects(subject1)("对应科目") = subject2 dicSubjects(subject2)("对应科目") = subject1 Next End With Set ws = ThisWorkbook.Sheets("发生额") With ws lRow = .UsedRange.Rows.Count lCol = .UsedRange.Columns.Count arr = .Range(.Cells(3, 1), .Cells(lRow, lCol)).Value End With For i = 1 To UBound(arr) subject1 = arr(i, 2) If subject1 <> "" Then customerORsupplier = arr(i, 7) balance = arr(i, 15) - arr(i, 16) If dicSubjects(subject1)("方向") = "贷" Then balance = balance * (-1) End If If Not dic.exists(subject1) Then Set dic(subject1) = CreateObject("Scripting.Dictionary") End If dic(subject1)(customerORsupplier) = dic(subject1)(customerORsupplier) + balance End If Next
第二部分，把dic中的数据，再次处理后，写入数组arr，再把arr写入工作表： '//期末余额借、贷方显示 i = 1 ReDim arr(1 To 4, 1 To i) arr(1, i) = "一级名称" arr(2, i) = "客商" arr(3, i) = "期末借方" arr(4, i) = "期末贷方" For Each key1 In dic.keys For Each key2 In dic(key1).keys balance = dic(key1)(key2) If balance <> 0 Then i = i + 1 ReDim Preserve arr(1 To 4, 1 To i) arr(1, i) = key1 arr(2, i) = key2 If dicSubjects(key1)("方向") = "借" Then If balance > 0 Then arr(3, i) = balance Else If changeSubject Then arr(1, i) = dicSubjects(key1)("对应科目") End If arr(4, i) = -balance End If Else If balance > 0 Then arr(4, i) = balance Else If changeSubject Then arr(1, i) = dicSubjects(key1)("对应科目") End If arr(3, i) = -balance End If End If End If Next Next With ws If changeSubject Then .Range("w3").Resize(.UsedRange.Rows.Count, 4).Cells.Clear Set rng = .Range("w2").Resize(UBound(arr, 2), 4) Else .Range("R3").Resize(.UsedRange.Rows.Count, 4).Cells.Clear Set rng = .Range("R2").Resize(UBound(arr, 2), 4) End If With rng .Value = Application.Transpose(arr) .Borders.LineStyle = 1 End With End With End Sub
![]()
| 安利小店
安利的牙膏非常不错，用了以后就不想再用其他的了；洗洁精、洗衣液也是日常必备，用过都说好！ |
![]()
| 合谷医疗
合谷医疗专攻各种疑难杂症，尤其擅长腰颈椎疾病、儿童神经发育异常、多动症、自闭孤独症治疗，可谓神乎其技！体验过的直呼早点来就好了！ |
![]()
| 我的付费知识星球：Excel活学活用
帮助VBA初学者提高VBA编程水平，欢迎加入！
|
喜欢就点个赞、点在看、留言评论、分享一下呗！感谢支持！
