[已解决]如何对数据做分层统计

fightpanda · 发表于 2014-10-29 09:49

本帖最后由 fightpanda 于 2014-10-29 10:09 编辑

目前数据有些不同：结果变量不都在一列中，会分布在几列，而且顺序不一致，可见下面的草表演示

A1编码 A2类型 B1第一种疾病 C1第二种疾病 D1第三种疾病 ···
1             1                X                         Y                   Z
2             2                X
3             3                Y                            Z
4             2                Z                            X
5             1                Z                            Y

X、Y、Z表示具体的疾病名称，B1、C1、D1只是存放某个人第一、二、三种疾病

请教该如何用数据透视表之类分别做出具体疾病X、Y、Z的分层分析（根据类型A2分）
即
类型    疾病X 疾病Y 疾病Z
1       具体数量
2
3

谢谢

最佳答案

月排行榜 / 总排行榜

dsmch

2014-10-29 10:47

Sub Macro1()
Dim arr, brr, d, d2, d3, i&, j%, zf$$
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
If j = 2 Then
d(arr(i, j)) = ""
Else
If arr(i, j) <> "" Then d2(arr(i, j)) = ""
End If
If j > 2 Then
zf = arr(i, 2) & "," & arr(i, j)
d3(zf) = d3(zf) + 1
End If
Next
Next
ReDim brr(1 To d.Count + 1, 1 To d2.Count + 1)
a = d.keys: b = d2.keys
For i = 0 To d.Count - 1
brr(i + 2, 1) = a(i)
For j = 0 To d2.Count - 1
brr(1, j + 2) = b(j)
brr(i + 2, j + 2) = d3(a(i) & "," & b(j))
Next
Next
Range("j1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

复制代码

跳转到最佳答案楼层

zyouong · 发表于 2014-10-29 09:57

上个附件，都不知道这些数据在哪行哪列怎么写公式呢？

fightpanda · 发表于 2014-10-29 10:09

zyouong 发表于 2014-10-29 09:57
上个附件，都不知道这些数据在哪行哪列怎么写公式呢？

已传，谢谢

dsmch · 发表于 2014-10-29 10:47

Sub Macro1()
Dim arr, brr, d, d2, d3, i&, j%, zf$$
Set d = CreateObject("scripting.dictionary")
Set d2 = CreateObject("scripting.dictionary")
Set d3 = CreateObject("scripting.dictionary")
arr = Range("a1").CurrentRegion
For i = 2 To UBound(arr)
For j = 2 To UBound(arr, 2)
If j = 2 Then
d(arr(i, j)) = ""
Else
If arr(i, j) <> "" Then d2(arr(i, j)) = ""
End If
If j > 2 Then
zf = arr(i, 2) & "," & arr(i, j)
d3(zf) = d3(zf) + 1
End If
Next
Next
ReDim brr(1 To d.Count + 1, 1 To d2.Count + 1)
a = d.keys: b = d2.keys
For i = 0 To d.Count - 1
brr(i + 2, 1) = a(i)
For j = 0 To d2.Count - 1
brr(1, j + 2) = b(j)
brr(i + 2, j + 2) = d3(a(i) & "," & b(j))
Next
Next
Range("j1").Resize(UBound(brr), UBound(brr, 2)) = brr
End Sub

复制代码

dsmch · 发表于 2014-10-29 10:48

………………

zyouong · 发表于 2014-10-29 10:52

分层分析.rar (10.39 KB, 下载次数: 9)

fightpanda · 发表于 2014-10-29 11:24

dsmch 发表于 2014-10-29 10:48
………………

感谢！

但是不知道怎么套用到正式要处理的数据中

代码哪几个地方需要修改？不知道方不方便解释

fightpanda · 发表于 2014-10-29 11:24

zyouong 发表于 2014-10-29 10:52

四楼是正解

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

[已解决]如何对数据做分层统计

相关帖子

点评