[已解决]如何按照字典序号的级次对数据进行分级汇总

eefnet@163.com · 发表于 2014-6-25 10:24

本帖最后由爱疯于 2014-6-25 11:24 编辑

序号1的数据=序号1.1 的数据+1.2的数据+1.3 的数据
序号1.1的数据 = 1.1.1的数据+1.1.2的数据+1.1.3的数据

如此类推依次汇总
那位高手能提示一下！不胜感谢！

最佳答案

月排行榜 / 总排行榜

fffox

2014-6-26 09:29

7楼的代码有点小错误，小改一下：

Option Explicit
Private Sub CommandButton1_Click()
Dim d As Object
Dim arr, brr
Dim i%, str$, j%, max%
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion.Value
For i = 1 To UBound(arr)
d(CStr(arr(i, 1))) = 0
Next
For i = UBound(arr) To 1 Step -1
max = UBound(Split(arr(i, 1), "."))
If max > 0 Then
str = ""
For j = 0 To max - 1
str = str & Split(arr(i, 1), ".")(j) & "."
Next
str = Left(str, Len(str) - 1)
If d(CStr(arr(i, 1))) = 0 Then d(CStr(arr(i, 1))) = arr(i, 3)
d(str) = d(str) + d(CStr(arr(i, 1)))
End If
Next
brr = d.items
[c1].Resize(d.Count) = WorksheetFunction.Transpose(brr)
End Sub

复制代码

跳转到最佳答案楼层

tgydslr · 发表于 2014-6-25 10:31

和楼主一起等着学习

baksy · 发表于 2014-6-25 10:42

D9、D10、D11 单元格各复制以下公式，
三键回车( 公式复制后,点一下公式编辑栏的任意位置,先按住 shift、ctrl 两个键,然后敲enter键。)
D9=SUM(IF(LEN(A$10:A$41)=1,$C$10:$C$41))
D10=SUM(IF((LEN(A$10:A$41)=3)*(LEFT(A$10:A$41)="1"),$C$10:$C$41))
D11=SUM(IF((LEN(A$10:A$41)=5)*(LEFT(A$10:A$41)="1"),$C$10:$C$41))

Zipall · 发表于 2014-6-25 11:13

sheet2
单击A列列标>数据>分列>向导第3步选文本>完成
然后在
d1输入 =IF(A2=A1&".1",,C1) 双击填充柄 (ps:这步的目的是将有子项的行都变0,如果你的原始数据所有需要计算和值的单元格都空着,那么这步实际可以省略)
e1输入 =IF(D1,D1,SUMIF(A2:A$32,A1&".*",D2))

baksy · 发表于 2014-6-25 11:24

SHEET2工作表的C1单元格复制以下公式，
三键回车、下拉。
=IF(LEN(A1)-LEN(SUBSTITUTE(A1,".",""))=0,SUM(IF((LEN(A$1:A$32)=3)*(LEFT(A$1:A$32)=A1),$C$1:$C$32)),IF(LEN(A1)-LEN(SUBSTITUTE(A1,".",""))=1,SUMIF(A$1:A$32,"="&(A1&"*"),$C$1:$C$32),""))

baksy · 发表于 2014-6-25 11:27

公式更新
SHEET2工作表的C1单元格公式，
=IF(LEN(A1)-LEN(SUBSTITUTE(A1,".",""))=0,SUM(IF((LEN(A$1:A$32)=3)*(LEFT(A$1:A$32)=A1),$C$1:$C$32)),IF(LEN(A1)-LEN(SUBSTITUTE(A1,".",""))=1,SUMIF(A$1:A$32,"="&(A1&"*"),$C$1:$C$32),A1))

fffox · 发表于 2014-6-25 12:28

使用VBA字典：

Option Explicit
Private Sub CommandButton1_Click()
Dim d As Object
Dim arr, brr
Dim i%, str$, j%, max%
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion.Value
For i = 1 To UBound(arr)
d(CStr(arr(i, 1))) = 0
Next
For i = UBound(arr) To 1 Step -1
max = UBound(Split(arr(i, 1), "."))
If max > 0 Then
str = ""
For j = 0 To max - 1
str = str & Split(arr(i, 1), ".")(j) & "."
Next
str = Left(str, Len(str) - 1)
d(str) = d(str) + arr(i, 3) + d(CStr(arr(i, 1)))
If d(CStr(arr(i, 1))) = 0 Then d(CStr(arr(i, 1))) = arr(i, 3)
End If
Next
brr = d.items
[c1].Resize(d.Count) = WorksheetFunction.Transpose(brr)
End Sub

复制代码

eefnet@163.com · 发表于 2014-6-25 17:59

非常感谢各位的支持！！

baksy · 发表于 2014-6-26 04:53

eefnet@163.com 发表于 2014-6-25 17:59
非常感谢各位的支持！！

现在楼主的sheet1里的数据是现成的，
这样在sheet2里直接调用sheet1里的数据就可以了。
C1=VLOOKUP(A1,Sheet1!$A$10:$C$41,3,0)
如果不是，
请提供原始的数据。

fffox · 发表于 2014-6-26 09:29

7楼的代码有点小错误，小改一下：

Option Explicit
Private Sub CommandButton1_Click()
Dim d As Object
Dim arr, brr
Dim i%, str$, j%, max%
Set d = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion.Value
For i = 1 To UBound(arr)
d(CStr(arr(i, 1))) = 0
Next
For i = UBound(arr) To 1 Step -1
max = UBound(Split(arr(i, 1), "."))
If max > 0 Then
str = ""
For j = 0 To max - 1
str = str & Split(arr(i, 1), ".")(j) & "."
Next
str = Left(str, Len(str) - 1)
If d(CStr(arr(i, 1))) = 0 Then d(CStr(arr(i, 1))) = arr(i, 3)
d(str) = d(str) + d(CStr(arr(i, 1)))
End If
Next
brr = d.items
[c1].Resize(d.Count) = WorksheetFunction.Transpose(brr)
End Sub

复制代码

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