利用vba进行会计科目汇总

cheree

原文件在下面、、、、

笨鸟飞不高

cheree 发表于 2020-6-24 22:42
原文件在下面、、、、

这个和第一个附件有什么区别？？

cheree

如果要用这种方式选择区域的话，arr该怎么定义，最后计算的时候又怎么刚好只呈现这部分的结果呢

cheree

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

我把具体的问题和原文件都发在下面了，能帮忙看看嘛！谢谢了

cheree

笨鸟飞不高 发表于 2020-6-24 22:45
这个和第一个附件有什么区别？？

没有区别的！就是想用我刚刚发的那个图片的方式引入区域该怎么做呢

cheree

笨鸟飞不高 发表于 2020-6-24 22:45
这个和第一个附件有什么区别？？

然后还有一个问题，就是如果不是像这样三级，而是四级五级甚至更多，应该怎么写代码呢

zpy2

cheree 发表于 2020-6-24 22:50
没有区别的！就是想用我刚刚发的那个图片的方式引入区域该怎么做呢

Select 科目代码,(select sum(科目余额) from 科目余额明细表 where 科目代码 like a.科目代码||'%') from 科目余额明细表 a

笨鸟飞不高

cheree 发表于 2020-6-24 23:12
然后还有一个问题，就是如果不是像这样三级，而是四级五级甚至更多，应该怎么写代码呢

利用vba进行会计科目汇总.rar (25.41 KB, 下载次数: 28)

2020-6-25 19:53 上传

点击文件名下载附件

猜一个！！！

deadzlq

PowerQuery参考解法

microyip

一个BOM表计算问题，效率不是很搞，但应该能满足贴主需求

1. Private vData As Variant, nRow As Long
   
2. Private dicItem As Object, dicParent As Object
   
3. Private vLevel As Variant
   
4. 
   
5. Sub BOM统计()
   
6.     Dim nVal As Double, vItem As Variant
   
7.    
   
8.     Application.ScreenUpdating = False
   
9.     Set dicItem = CreateObject("Scripting.Dictionary") 'BOM表项目值
   
10.     Set dicParent = CreateObject("Scripting.Dictionary") 'BOM表子项对应的父项
    
11.     With Sheet1
    
12.         nRow = .Cells(.Rows.Count, 1).Row
    
13.         vData = .[A1:B1].Resize(nRow, 2).Value
    
14.         For nRow = 1 To UBound(vData)
    
15.             If vData(nRow, 1) <> "" Then
    
16.                 vLevel = Split(vData(nRow, 1), ".")
    
17.                 If UBound(vData, 2) - 2 < UBound(vLevel) + 1 Then ReDim Preserve vData(1 To UBound(vData), 1 To 2 + UBound(vLevel) + 1)
    
18.                 SetDic
    
19.             End If
    
20.         Next
    
21.         
    
22.         For Each vItem In dicItem.Keys
    
23.             nVal = dicItem(vItem)
    
24.             Do While dicParent.Exists(vItem)
    
25.                 vItem = dicParent(vItem)
    
26.                 dicItem(vItem) = dicItem(vItem) + nVal
    
27.             Loop
    
28.         Next
    
29.         For nRow = 1 To UBound(vData)
    
30.             vData(nRow, 2) = dicItem(Trim(vData(nRow, 1)))
    
31.         Next
    
32.         .[A1:B1].Resize(UBound(vData), 2) = vData
    
33.     End With
    
34.     Application.ScreenUpdating = True
    
35. End Sub
    
36. 
    
37. Private Function SetDic(Optional ByVal Level As Long = 1, Optional ByVal Parent As Variant = Empty)
    
38.     Dim vKey As Variant, vSon As Variant
    
39.    
    
40.     vKey = vLevel(Level - 1)
    
41.     vData(nRow, 2 + Level) = vKey
    
42.    
    
43.     If Parent <> "" Then vSon = Parent & "."
    
44.     vSon = vSon & vKey
    
45.     If Parent <> "" Then dicParent(vSon) = Parent
    
46.    
    
47.     If Level = UBound(vLevel) + 1 Then
    
48.         dicItem(vSon) = vData(nRow, 2)
    
49.     Else
    
50.         If dicItem.Exists(vSon) Then dicItem.Remove vSon
    
51.         SetDic Level:=Level + 1, Parent:=vSon
    
52.     End If
    
53. End Function

复制代码