利用vba进行会计科目汇总

cheree · 发表于 2020-6-24 18:19

利用vba对会计科目汇总，输入最末级的科目的金额（白色部分），然后能得到每一级的汇总数量（黄色），应该怎么做呢

ccwan · 发表于 2020-6-24 19:50

Sub cc()
Dim arr, rng, i%, j%, num1&, num2&, num3&, a As Boolean
arr = Range("a1:b" & [a1048576].End(3).Row)
For i = UBound(arr) To 1 Step -1
Do While Left(arr(i, 1), 1) = Left(arr(i - 1, 1), 1)
rng = Split(arr(i, 1), ".")
If UBound(rng) = 2 Then
num1 = num1 + arr(i, 2)
End If
If UBound(rng) = 1 Then
num2 = num2 + num1
num1 = 0
a = True
End If
If a = True Then
arr(i, 2) = num2
num3 = num3 + num2
num2 = 0
a = False
End If
i = i - 1
If i = 1 Then Exit Do
Loop
arr(i, 2) = num3
num3 = 0
Next
[b1].Resize(UBound(arr)) = Application.Index(arr, , 2)
End Sub

复制代码

ccwan · 发表于 2020-6-24 19:52

审核中，发附件吧

ccwan · 发表于 2020-6-24 20:00

重新改一下，整复杂了

Sub cc()
Dim arr, rng, i%, j%, num1&, num2&, num3&, a As Boolean
arr = Range("a1:b" & [a1048576].End(3).Row)
For i = UBound(arr) To 1 Step -1
Do While Left(arr(i, 1), 1) = Left(arr(i - 1, 1), 1)
rng = Split(arr(i, 1), ".")
If UBound(rng) = 2 Then
num1 = num1 + arr(i, 2)
End If
If UBound(rng) = 1 Then
num2 = num2 + num1
num1 = 0
arr(i, 2) = num2
num3 = num3 + num2
num2 = 0
End If
i = i - 1
If i = 1 Then Exit Do
Loop
arr(i, 2) = num3
num3 = 0
Next
[c1].Resize(UBound(arr)) = Application.Index(arr, , 2)
End Sub

复制代码

wdwlywpl · 发表于 2020-6-24 20:15

学习了，谢谢分享

cheree · 发表于 2020-6-24 20:28

ccwan 发表于 2020-6-24 19:52
审核中，发附件吧

非常感谢！，那如果不止三级，有四级五级这种怎么做呢

笨鸟飞不高 · 发表于 2020-6-24 21:54

Sub AwTest()
Dim i%, iStr$, arr, d As Object
Set d = CreateObject("Scripting.Dictionary")
arr = [a1].CurrentRegion
For i = 1 To UBound(arr)
      If Len(arr(i, 1)) = 3 Then
         d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)
      Else
         d(Left(arr(i, 1), 3)) = d(Left(arr(i, 1), 3)) + arr(i, 2)
         d(Left(arr(i, 1), 1)) = d(Left(arr(i, 1), 1)) + arr(i, 2)
      End If
Next
For i = 1 To UBound(arr)
      If Len(arr(i, 2)) = 0 Then iStr = arr(i, 1): arr(i, 2) = d(iStr)
Next
[a1].CurrentRegion = arr
End Sub

凑一个！！

cheree · 发表于 2020-6-24 22:13

笨鸟飞不高发表于 2020-6-24 21:54
Sub AwTest()
Dim i%, iStr$, arr, d As Object
Set d = CreateObject("Scripting.Dictionary")
...

如果不是从a1单元格开始，而是窗口先询问需要合并的会计科目区域，以及金额合并的区域，然后根据这个区域计算，应该怎么写代码呢

笨鸟飞不高 · 发表于 2020-6-24 22:20

本帖最后由笨鸟飞不高于 2020-6-24 22:21 编辑

cheree 发表于 2020-6-24 22:13
如果不是从a1单元格开始，而是窗口先询问需要合并的会计科目区域，以及金额合并的区域，然后根据这个区域 ...

选择区域赋给数组，试试！！！
arr=Selection....
有问题，有要求可以上传附件！！！

cheree · 发表于 2020-6-24 22:40

笨鸟飞不高发表于 2020-6-24 22:20
选择区域赋给数组，试试！！！
arr=Selection....
有问题，有要求可以上传附件！！！

就是想用set arr1 = Application.InputBox("请选择科目代码区域:", Type:=8)，Set arr2 = Application.InputBox("请选择求和金额区域:", Type:=8)选择区域，但是之后怎么给arr赋值，最后怎么将值按照之前选择的区域放置呢，我把文件链接放下一楼回复吧

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

[求助] 利用vba进行会计科目汇总