[已解决]如何多条件进行分类统计？

gwfzh

各位老师：

          怎样按 下述统计表（sheet1表）的要求对sheet2表的（F列、G列、O列、I列）进行统计？sheet1表中：

           1、第一行E1：AE1区域是统计表中的年龄组分类（sheet2表中G列年龄进行分类）；

            2、第二列“性别分类”（sheet1表中B:B列）：是按sheet2表F列中分“合计”、“男性”、“女性”三大类进行统计；

            3、第三列“名称分类”（sheet1表中C:C列）：是取sheet2表“名称（o列）”不重复的值有若干行；

            4、然后按照疾病名称（sheet2表o列）、年龄、性别三条件要求对sheet2表的（F列、G列、O列）进行发病死统计；

            5、在进行上述统计的同时，按同样的要求，对sheet2表I：I列进行上述同样的死亡统计。

              如何进行多条件（疾病名称（sheet2表o列）、年龄、性别）统计？请各位老师帮忙了！谢谢！！！
多条件分类统计.rar (157.44 KB, 下载次数: 26)

2014-5-5 15:44 上传

点击文件名下载附件

由于 sheet2表“名称（o列）”的名称较复杂，第三列“名称分类”（sheet1表中C:C列）可按 Left(Arr(i, 10), 1))函数取sheet2表“名称（o列）”单元格的第一个字符统一名称后，再按第一个字符值进行分类统计

最佳答案

月排行榜 / 总排行榜

grf1973

2014-5-6 11:25

嗯，年龄段分好后，设置key时没用。代码改了一下，至少白血病是对了，其它你再看看吧。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")   '疾病
   
3.     Set d1 = CreateObject("scripting.dictionary")   '发病+死亡
   
4.     Set d2 = CreateObject("scripting.dictionary")   '死亡
   
5.     r = Sheet2.UsedRange.Rows.Count
   
6.     Arr = Sheet2.Range("a1:o" & r)
   
7.     For i = 2 To UBound(Arr)
   
8.         ill = Left(Arr(i, 15), 1)
   
9.         d(ill) = ""
   
10.         age = Val(Arr(i, 7)) '年龄
    
11.         For k = 85 To 10 Step -5
    
12.             If age < k And age >= k - 5 Then age = k - 5: Exit For
    
13.         Next
    
14.         If age >= 85 Then age = 85
    
15.         xkey = Arr(i, 6) & age & ill   '性别+年龄+疾病为key
    
16.         xkey1 = "合计" & age & ill '合计+年龄+疾病为key
    
17.         d1(xkey) = d1(xkey) + 1  '发病+死亡，分男女
    
18.         d1(xkey1) = d1(xkey1) + 1  '发病+死亡，不分男女
    
19.         If Len(Arr(i, 9)) > 0 Then  '第9列非空，表示死亡
    
20.             d2(xkey) = d2(xkey) + 1   '死亡，分男女
    
21.             d2(xkey1) = d2(xkey1) + 1   '死亡，不分男女
    
22.         End If
    
23.     Next
    
24.             
    
25.     n = d.Count
    
26.     With Sheet1
    
27.         .[b2:c65536].Clear
    
28.         For i = 1 To 6  '显示6次
    
29.             r = .[c65536].End(3).Row + 1
    
30.             If i = 1 Or i = 4 Then b = "合计"
    
31.             If i = 2 Or i = 5 Then b = "男"
    
32.             If i = 3 Or i = 6 Then b = "女"
    
33.             .Cells(r, 2).Resize(n) = b
    
34.             .Cells(r, 3).Resize(n) = Application.Transpose(d.keys)
    
35.             .Cells(r + n, 3) = "合计"
    
36.         Next
    
37.         Arr = .[a1].CurrentRegion
    
38.         For i = 2 To UBound(Arr)
    
39.             For j = 5 To UBound(Arr, 2)
    
40.                 xkey = Arr(i, 2) & Arr(1, j) & Arr(i, 3)   '性别+年龄+疾病为key（或者 合计+年龄+疾病为key）
    
41.                 If i <= 3 * (n + 1) + 1 Then Arr(i, j) = d1(xkey) Else Arr(i, j) = d2(xkey)  '上半部分显示发病（含死亡），下半部分表示死亡
    
42.             Next
    
43.         Next
    
44.         .[a1].CurrentRegion = Arr
    
45.         r = .[c65536].End(3).Row + 1
    
46.         For i = 2 To r
    
47.             If .Cells(i, 3) = "合计" Then
    
48.                 .Cells(i, 5).Resize(1, 27).Formula = "=sum(r[-" & n & "]c:r[-1]c)"
    
49.             End If
    
50.             .Cells(i, 4) = Application.Sum(.Cells(i, 5).Resize(1, 27))
    
51.         Next
    
52.     End With
    
53. End Sub

复制代码

跳转到最佳答案楼层

gwfzh

顶！！！！！

gwfzh

请老师们帮助解决！！！！！

grf1973

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")   '疾病
   
3.     Set d1 = CreateObject("scripting.dictionary")   '发病+死亡
   
4.     Set d2 = CreateObject("scripting.dictionary")   '死亡
   
5.     r = Sheet2.UsedRange.Rows.Count
   
6.     Arr = Sheet2.Range("a1:o" & r)
   
7.     For i = 2 To UBound(Arr)
   
8.         d(Arr(i, 15)) = ""
   
9.         age = Val(Arr(i, 7)) '年龄
   
10.         For k = 85 To 10 Step -5
    
11.             If age < k And age >= k - 5 Then age = k - 5
    
12.         Next
    
13.         If age >= 85 Then age = 85
    
14.         xkey = Arr(i, 6) & Arr(i, 7) & Arr(i, 15)   '性别+年龄+疾病为key
    
15.         xkey1 = "合计" & Arr(i, 7) & Arr(i, 15) '合计+年龄+疾病为key
    
16.         d1(xkey) = d1(xkey) + 1  '发病+死亡，分男女
    
17.         d1(xkey1) = d1(xkey1) + 1  '发病+死亡，不分男女
    
18.         If Len(Arr(i, 9)) > 0 Then  '第9列非空，表示死亡
    
19.             d2(xkey) = d2(xkey) + 1   '死亡，分男女
    
20.             d2(xkey1) = d2(xkey1) + 1   '死亡，不分男女
    
21.         End If
    
22.     Next
    
23.             
    
24.     n = d.Count
    
25.     With Sheet1
    
26.         .[b2:c65536].Clear
    
27.         For i = 1 To 6  '显示6次
    
28.             r = .[c65536].End(3).Row + 1
    
29.             If i = 1 Or i = 4 Then b = "合计"
    
30.             If i = 2 Or i = 5 Then b = "男"
    
31.             If i = 3 Or i = 6 Then b = "女"
    
32.             .Cells(r, 2).Resize(n) = b
    
33.             .Cells(r, 3).Resize(n) = Application.Transpose(d.keys)
    
34.             .Cells(r + n, 3) = "合计"
    
35.         Next
    
36.         Arr = .[a1].CurrentRegion
    
37.         For i = 2 To UBound(Arr)
    
38.             For j = 5 To UBound(Arr, 2)
    
39.                 xkey = Arr(i, 2) & Arr(1, j) & Arr(i, 3)   '性别+年龄+疾病为key（或者 合计+年龄+疾病为key）
    
40.                 If i <= 3 * (n + 1) + 1 Then Arr(i, j) = d1(xkey) Else Arr(i, j) = d2(xkey)  '上半部分显示发病（含死亡），下半部分表示死亡
    
41.             Next
    
42.         Next
    
43.         .[a1].CurrentRegion = Arr
    
44.         r = .[c65536].End(3).Row + 1
    
45.         r1 = 2
    
46.         For i = 223 To r
    
47.             If .Cells(i, 3) = "合计" Then
    
48.                 .Cells(i, 5).Resize(1, 27).Formula = "=sum(r[-" & n & "]c:r[-1]c)"
    
49.                 .Cells(i, 4) = Application.Sum(.Cells(i, 5).Resize(1, 27))
    
50.             End If
    
51.         Next
    
52.     End With
    
53. End Sub

复制代码

grf1973

数据量比较大，难以检验。可少弄点数据试试结果是否正确。另外未设置工作表格式，合并单元格等，自己弄吧。

grf1973

没注意说明里疾病只要取首字即可。代码小改一下。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")   '疾病
   
3.     Set d1 = CreateObject("scripting.dictionary")   '发病+死亡
   
4.     Set d2 = CreateObject("scripting.dictionary")   '死亡
   
5.     r = Sheet2.UsedRange.Rows.Count
   
6.     Arr = Sheet2.Range("a1:o" & r)
   
7.     For i = 2 To UBound(Arr)
   
8.         ill = Left(Arr(i, 15), 1)
   
9.         d(ill) = ""
   
10.         age = Val(Arr(i, 7)) '年龄
    
11.         For k = 85 To 10 Step -5
    
12.             If age < k And age >= k - 5 Then age = k - 5
    
13.         Next
    
14.         If age >= 85 Then age = 85
    
15.         xkey = Arr(i, 6) & Arr(i, 7) & ill   '性别+年龄+疾病为key
    
16.         xkey1 = "合计" & Arr(i, 7) & ill '合计+年龄+疾病为key
    
17.         d1(xkey) = d1(xkey) + 1  '发病+死亡，分男女
    
18.         d1(xkey1) = d1(xkey1) + 1  '发病+死亡，不分男女
    
19.         If Len(Arr(i, 9)) > 0 Then  '第9列非空，表示死亡
    
20.             d2(xkey) = d2(xkey) + 1   '死亡，分男女
    
21.             d2(xkey1) = d2(xkey1) + 1   '死亡，不分男女
    
22.         End If
    
23.     Next
    
24.             
    
25.     n = d.Count
    
26.     With Sheet1
    
27.         .[b2:c65536].Clear
    
28.         For i = 1 To 6  '显示6次
    
29.             r = .[c65536].End(3).Row + 1
    
30.             If i = 1 Or i = 4 Then b = "合计"
    
31.             If i = 2 Or i = 5 Then b = "男"
    
32.             If i = 3 Or i = 6 Then b = "女"
    
33.             .Cells(r, 2).Resize(n) = b
    
34.             .Cells(r, 3).Resize(n) = Application.Transpose(d.keys)
    
35.             .Cells(r + n, 3) = "合计"
    
36.         Next
    
37.         Arr = .[a1].CurrentRegion
    
38.         For i = 2 To UBound(Arr)
    
39.             For j = 5 To UBound(Arr, 2)
    
40.                 xkey = Arr(i, 2) & Arr(1, j) & Arr(i, 3)   '性别+年龄+疾病为key（或者 合计+年龄+疾病为key）
    
41.                 If i <= 3 * (n + 1) + 1 Then Arr(i, j) = d1(xkey) Else Arr(i, j) = d2(xkey)  '上半部分显示发病（含死亡），下半部分表示死亡
    
42.             Next
    
43.         Next
    
44.         .[a1].CurrentRegion = Arr
    
45.         r = .[c65536].End(3).Row + 1
    
46.         r1 = 2
    
47.         For i = 223 To r
    
48.             If .Cells(i, 3) = "合计" Then
    
49.                 .Cells(i, 5).Resize(1, 27).Formula = "=sum(r[-" & n & "]c:r[-1]c)"
    
50.                 .Cells(i, 4) = Application.Sum(.Cells(i, 5).Resize(1, 27))
    
51.             End If
    
52.         Next
    
53.     End With
    
54. End Sub

复制代码

grf1973

第47句应该是For i = 2 To r，调试后没改回来。。。。。。

gwfzh

grf1973 发表于 2014-5-6 10:38
第47句应该是For i = 2 To r，调试后没改回来。。。。。。

谢谢grf1973老师的帮助！统计有错误：例如“白血病”总例数合计有26例，其中男18例、女8例，你的合计只有8例、男性只有7例、女性却只有1例

grf1973

嗯，年龄段分好后，设置key时没用。代码改了一下，至少白血病是对了，其它你再看看吧。

1. Sub tt()
   
2.     Set d = CreateObject("scripting.dictionary")   '疾病
   
3.     Set d1 = CreateObject("scripting.dictionary")   '发病+死亡
   
4.     Set d2 = CreateObject("scripting.dictionary")   '死亡
   
5.     r = Sheet2.UsedRange.Rows.Count
   
6.     Arr = Sheet2.Range("a1:o" & r)
   
7.     For i = 2 To UBound(Arr)
   
8.         ill = Left(Arr(i, 15), 1)
   
9.         d(ill) = ""
   
10.         age = Val(Arr(i, 7)) '年龄
    
11.         For k = 85 To 10 Step -5
    
12.             If age < k And age >= k - 5 Then age = k - 5: Exit For
    
13.         Next
    
14.         If age >= 85 Then age = 85
    
15.         xkey = Arr(i, 6) & age & ill   '性别+年龄+疾病为key
    
16.         xkey1 = "合计" & age & ill '合计+年龄+疾病为key
    
17.         d1(xkey) = d1(xkey) + 1  '发病+死亡，分男女
    
18.         d1(xkey1) = d1(xkey1) + 1  '发病+死亡，不分男女
    
19.         If Len(Arr(i, 9)) > 0 Then  '第9列非空，表示死亡
    
20.             d2(xkey) = d2(xkey) + 1   '死亡，分男女
    
21.             d2(xkey1) = d2(xkey1) + 1   '死亡，不分男女
    
22.         End If
    
23.     Next
    
24.             
    
25.     n = d.Count
    
26.     With Sheet1
    
27.         .[b2:c65536].Clear
    
28.         For i = 1 To 6  '显示6次
    
29.             r = .[c65536].End(3).Row + 1
    
30.             If i = 1 Or i = 4 Then b = "合计"
    
31.             If i = 2 Or i = 5 Then b = "男"
    
32.             If i = 3 Or i = 6 Then b = "女"
    
33.             .Cells(r, 2).Resize(n) = b
    
34.             .Cells(r, 3).Resize(n) = Application.Transpose(d.keys)
    
35.             .Cells(r + n, 3) = "合计"
    
36.         Next
    
37.         Arr = .[a1].CurrentRegion
    
38.         For i = 2 To UBound(Arr)
    
39.             For j = 5 To UBound(Arr, 2)
    
40.                 xkey = Arr(i, 2) & Arr(1, j) & Arr(i, 3)   '性别+年龄+疾病为key（或者 合计+年龄+疾病为key）
    
41.                 If i <= 3 * (n + 1) + 1 Then Arr(i, j) = d1(xkey) Else Arr(i, j) = d2(xkey)  '上半部分显示发病（含死亡），下半部分表示死亡
    
42.             Next
    
43.         Next
    
44.         .[a1].CurrentRegion = Arr
    
45.         r = .[c65536].End(3).Row + 1
    
46.         For i = 2 To r
    
47.             If .Cells(i, 3) = "合计" Then
    
48.                 .Cells(i, 5).Resize(1, 27).Formula = "=sum(r[-" & n & "]c:r[-1]c)"
    
49.             End If
    
50.             .Cells(i, 4) = Application.Sum(.Cells(i, 5).Resize(1, 27))
    
51.         Next
    
52.     End With
    
53. End Sub

复制代码

grf1973

改动处主要是在第12   15   16句。