老师请帮忙：根据要求统计数量

沙漠滴雨

yjh_27 发表于 2014-4-3 21:26
附件里有公式，简单有效。

希望一次生成。

谢谢老师。

沙漠滴雨

沙漠滴雨 发表于 2014-4-3 21:27
谢谢老师。

让您耽误时间和精力了，不好意思。

chxw68

沙漠滴雨 发表于 2014-4-3 21:22
再次感谢老师！
1、能让二级列也自动生成吗？

二级列依据什么划分类呢？

沙漠滴雨

chxw68 发表于 2014-4-3 21:53
二级列依据什么划分类呢？

老师，我的意思是：一级包括701A，二级包括702B，三级包括703C——711K九个小类，四级包括712N——721X10个小类，五级包括722Z。
但有时候可能三四级包括的小类少了，那么，就少生成。
您明白我的意思吗？

chxw68

沙漠滴雨 发表于 2014-4-3 22:04
老师，我的意思是：一级包括701A，二级包括702B，三级包括703C——711K九个小类，四级包括712N——721X10 ...

你的数据表中编号前4位不是连续的？比如最后一位就没有L和M。

yjh_27

沙漠滴雨 发表于 2014-4-3 21:14
感谢老师关注与帮助，但D列内容没有生成：

3、不想在D列再做公式。

合并单元格没做。（在各单元格填相同值）

yjh_27

沙漠滴雨 发表于 2014-4-3 21:30
希望一次生成。

谢谢老师。

见楼上附件。

黄色区域对照表是必须的。

美化工作你自己做吧

chxw68

1. Sub test()
   
2.   Dim d As Object
   
3.   Dim d1 As Object
   
4.   Dim r%, i%
   
5.   Dim arr, brr
   
6.   Set d = CreateObject("scripting.dictionary")
   
7.   Set d1 = CreateObject("scripting.dictionary")
   
8.   
   
9.   Application.DisplayAlerts = False
   
10.   fl = Array("701A", "702B", "703C", "704D", "705E", "706F", "707G", "708H", "709I", "710J", "711K", "712N", "713O", "714P", "715Q", "716R", "717S", "718T", "719U", "720V", "721X", "722Z")
    
11.   V = Array(1, 2, 3, 12, 21, 22)
    
12.   For i = 0 To UBound(fl)
    
13.     d(fl(i)) = Application.Match(i + 1, V, 1)
    
14.   Next
    
15.   With Worksheets("数据")
    
16.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
17.     arr = .Range("a2:c" & r)
    
18.   End With
    
19.   For i = 1 To UBound(arr)
    
20.     xm = Left(arr(i, 1), 4)
    
21.     If arr(i, 2) <> "缺少" Then
    
22.       d1(xm) = d1(xm) + 1
    
23.     End If
    
24.   Next
    
25.   
    
26.   With Worksheets("sheet1")
    
27.     .Cells.Delete
    
28.     .Range("a1:d1") = Array("一级", "二级", "数量", "合计")
    
29.     .Range("a2").Resize(d.Count, 2) = Application.Transpose(Array(d.Items, d.Keys))
    
30.     r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
31.     arr = .Range("b2:d" & r)
    
32.     For i = 1 To UBound(arr)
    
33.       If d1.Exists(arr(i, 1)) Then
    
34.         arr(i, 2) = d1(arr(i, 1))
    
35.       End If
    
36.     Next
    
37.     .Range("b2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
38.     For i = 0 To UBound(V) - 1
    
39.       .Cells(V(i) + 1, 1) = "第" & Application.Text(i + 1, "[dbnum1]") & "类"
    
40.       .Cells(V(i) + 1, 1).Resize(V(i + 1) - V(i), 1).Merge
    
41.       .Cells(V(i) + 1, 4).FormulaR1C1 = "=SUM(RC[-1]:R[" & V(i + 1) - V(i) - 1 & "]C[-1])"
    
42.       .Cells(V(i) + 1, 4).Resize(V(i + 1) - V(i), 1).Merge
    
43.     Next
    
44.     .Cells(V(i) + 1, 1) = "第" & Application.Text(i + 1, "[dbnum1]") & "类"
    
45.     .Cells(V(i) + 1, 4).FormulaR1C1 = "=SUM(RC[-1]:R[" & r - V(i) - 1 & "]C[-1])"
    
46.   End With
    
47. End Sub
    

复制代码

chxw68

整个统计表都是由程序自动生成的，包括纵横表头。

沙漠滴雨

yjh_27 发表于 2014-4-3 22:54
见楼上附件。

黄色区域对照表是必须的。

感谢老师热心帮助。

但您瞧：



圆圈处没有统计出来。

是我没有操作好吗？