如何正确汇总出第三级数据

chxw68 · 发表于 2017-3-6 11:26

kezhiye 发表于 2017-3-6 11:04
明细是分一的合并，实际工作薄中，不止分1，而是有分1到分12，明细表是分1到分12的合并（只是合并不是汇 ...

那么汇总数据是从“明细”提取呢，还是从“分一”、“分二”等表提取呢？

kezhiye · 发表于 2017-3-6 12:27

  我感觉主要是以下这段代码要进行修改，因为只有三级代码的是时候，也就是代码列的位数最高只有10位的时候，汇总结果是正确的，只是在增加一级以后（也就是最高位数增加三位）才出现第三级有的有汇总数有的没有汇总数。估计是以下代码的循环只判断一级（即四位数）、二级（即七位数）、和大于二级这三种情况，所以会出现三级下面如果没有四级的则能够得出三级的汇总数（如张三李四的三级有汇总数），而三级下面有四级的则得不出三级的汇总数（如王五郑七的三级没有汇总数）。如果将现在的三级循环判断再增加成一级循环判断，即增加第三级（10位数的），由原来的判断一级、二级和大于二级改成判断一级、二级、三级和大于三级，问题应该就能解决了。

K2 = 0: K3 = 0
For d = i To 2 Step -1
sh.Range("Y" & d).Value = Left(sh.Range("A" & d) * 1000000, 9)
   If sh.Range("Y" & d) Mod 100 > 0 Then
      K3 = IIf(K3 = 0, d, K3)
   ElseIf sh.Range("Y" & d) Mod 100000 > 0 Then
         If K3 > 0 Then
         sh.Range(sh.Cells(d, 6), sh.Cells(d, 10)).FormulaR1C1 = "=sum(r[1]c:r[" & K3 - d & "]c)"
         sh.Range("A" & d & ":M" & d).Interior.ColorIndex = 40 '35
         End If
         K3 = 0: K2 = IIf(K2 = 0, d, K2)
      Else
         If K2 > 0 Then
      sh.Range(sh.Cells(d, 6), sh.Cells(d, 10)).FormulaR1C1 = "=sumproduct((left(r[1]c25:r" & K2 & "c25,4)=left(rc25,4))*(right(r[1]c25:r" & K2 & "c25,2)=""00"")*r[1]c:r" & K2 & "c)"
      sh.Range("A" & d & ":M" & d).Interior.ColorIndex = 4 '35
         End If
         K2 = 0
      End If
   sh.Range("F" & d & ":L" & d).Value = sh.Range("F" & d & ":L" & d).Value
   Next

   For k = 2 To i
      cc4 = sh.Cells(k, 4): cc5 = sh.Cells(k, 5): cc6 = sh.Cells(k, 6): cc7 = sh.Cells(k, 7)
      cc11 = sh.Cells(k, 11): cc12 = sh.Cells(k, 12)
      sh.Cells(k, 10) = IIf(sh.Cells(k, 3) = "借", Val(cc5 + cc6 - cc7), Val(cc5 + cc7 - cc6))
      sh.Cells(k, 13) = IIf(sh.Cells(k, 3) = "借", Val(cc4 + cc11 - cc12), Val(cc4 + cc12 - cc11))
      Next k

kezhiye · 发表于 2017-3-6 12:40

sh.Range("Y" & d).Value = Left(sh.Range("A" & d) * 1000000, 9)
   If sh.Range("Y" & d) Mod 100 > 0 Then
      K3 = IIf(K3 = 0, d, K3)
   ElseIf sh.Range("Y" & d) Mod 100000 > 0 Then

这四行，我除了第一行能明白，后面三行都搞不懂，而这好象正是判断二级和三级的地方，如果把这里增加一级判断，改成判断二级、三级和四级，估计问题就解决了

kezhiye · 发表于 2017-3-6 12:46

代码是有规律的，一级代码就是4位数，二级代码就7位数，三级代码就是10位数，四级代码就是13位数，这个是固定。有一级的不一定有二级，但有四级的则一定是有一二三级的。有二级的不一定有三级，有三级的则一定有一二级的。也就是有高级的不一定有低级，有低级则一定有它的高级。

kezhiye · 发表于 2017-3-6 14:29

一楼附件增加了问题描述，重新上传，看能不能让问题更容易明白。请师傅们继续帮忙看看

wj2368 · 发表于 2017-3-6 16:10

本帖最后由 wj2368 于 2017-3-6 16:17 编辑

短信收到，不知道是不是你要的结果。

wj2368 · 发表于 2017-3-6 16:16

kezhiye 发表于 2017-3-6 14:29
一楼附件增加了问题描述，重新上传，看能不能让问题更容易明白。请师傅们继续帮忙看看

短信收到，看是不是你要的结果

wj2368 · 发表于 2017-3-6 16:18

怎么发了二次

chxw68 · 发表于 2017-3-6 16:21

Sub test()
Dim r%, i%
Dim arr, brr, hj(1 To 10)
Dim d As Object
Dim flg As Boolean
Set d = CreateObject("scripting.dictionary")
With Worksheets("代码科目")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:g" & r)
For i = 1 To UBound(arr)
If Not d.exists(arr(i, 1)) Then
ReDim brr(1 To 13)
brr(1) = arr(i, 1)
brr(2) = arr(i, 2)
brr(3) = arr(i, 3)
brr(4) = arr(i, 6)
brr(5) = arr(i, 7)
d(arr(i, 1)) = brr
End If
Next
End With
With Worksheets("明细")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:l" & r)
For i = 1 To UBound(arr)
If d.exists(arr(i, 2)) Then
brr = d(arr(i, 2))
brr(6) = brr(6) + arr(i, 10)
brr(7) = brr(7) + arr(i, 12)
brr(11) = brr(11) + arr(i, 9)
brr(12) = brr(12) + arr(i, 11)
d(arr(i, 2)) = brr
End If
Next
End With
With Worksheets("分1")
r = .Cells(.Rows.Count, 1).End(xlUp).Row
arr = .Range("a2:l" & r)
For i = 1 To UBound(arr)
If d.exists(arr(i, 2)) Then
brr = d(arr(i, 2))
brr(8) = brr(8) + arr(i, 10)
brr(9) = brr(9) + arr(i, 12)
d(arr(i, 2)) = brr
End If
Next
End With
arr = Application.Transpose(Application.Transpose(d.items))
For i = UBound(arr) - 1 To 1 Step -1
bm = arr(i, 1)
j = i + 1
Do While arr(j, 1) Like bm & "*"
If arr(j, 1) Like bm & "???" Then
For k = 1 To 10
hj(k) = hj(k) + arr(j, k + 3)
Next
flg = True
End If
j = j + 1
If j > UBound(arr) Then
Exit Do
End If
Loop
If flg Then
For k = 1 To 10
arr(i, k + 3) = hj(k)
Next
flg = flase
Erase hj
End If
Next
With Worksheets("汇总")
.UsedRange.Offset(1, 0).Clear
.Columns(1).NumberFormatLocal = "@"
.Range("a2").Resize(UBound(arr), UBound(arr, 2)) = arr
End With
End Sub

复制代码

chxw68 · 发表于 2017-3-6 16:23

详见附件。

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

[求助] 如何正确汇总出第三级数据