[已解决]又一个让人疼的问题，试到现在也没成功，请老师指点

sh790512

我有个表中有好多数据，要对其中医院进行汇总统计，如何用VBA进行呢？问题在表中有说明。先对关注问题的老师进行感谢。 Book1.rar (81.47 KB, 下载次数: 23)

2012-12-26 22:45 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

suye1010

2012-12-26 23:12

1. Option Explicit
   
2. 
   
3. Sub Summary()
   
4. Dim d, arr, TempArr, i As Integer, j As Integer, Hospital
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. arr = Range("A1").CurrentRegion ’这里把整个工作表包含数据的区域都赋值给数组
   
7. For i = 2 To UBound(arr)
   
8.     If d.exists(arr(i, 1)) Then
   
9.         TempArr = d(arr(i, 1))'这里1改为你的医院名称所在列对应列数
   
10.         TempArr(1) = TempArr(1) + arr(i, 2)
    
11. '这里2改为医疗费用所在列对应列数
    
12.         TempArr(2) = TempArr(2) + arr(i, 3)
    
13. '这里1改为报销数额所在列对应列数
    
14.         TempArr(3) = TempArr(3) + 1
    
15.         d(arr(i, 1)) = TempArr
    
16.     Else
    
17.         ReDim TempArr(1 To 3)
    
18.         TempArr(1) = arr(i, 2)
    
19.         TempArr(2) = arr(i, 3)
    
20.         TempArr(3) = 1
    
21.         d.Add arr(i, 1), TempArr
    
22.     End If
    
23.     Erase TempArr
    
24. Next i
    
25. j = 2
    
26. For Each Hospital In d.keys
    
27.     Cells(j, "H") = Hospital ' 这里的H改为你打算放统计数据的列标签，以下类似
    
28.     Cells(j, "I").Resize(1, 3) = d(Hospital)
    
29.     j = j + 1
    
30. Next
    
31. End Sub
    

复制代码

跳转到最佳答案楼层

feedyu

这个,真心不用V来解决啊
数据透视表就完全可以搞定了.(PS:楼主的这个表格格式做得非常好,最适合做数透的表格布局)

hwc2ycy

去看看数透公开课的录相吧，对你有帮助。

suye1010

1. Option Explicit
   
2. 
   
3. Sub Summary()
   
4. Dim d, arr, TempArr, i As Integer, j As Integer, Hospital
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. arr = Range("A1").CurrentRegion ’这里把整个工作表包含数据的区域都赋值给数组
   
7. For i = 2 To UBound(arr)
   
8.     If d.exists(arr(i, 1)) Then
   
9.         TempArr = d(arr(i, 1))'这里1改为你的医院名称所在列对应列数
   
10.         TempArr(1) = TempArr(1) + arr(i, 2)
    
11. '这里2改为医疗费用所在列对应列数
    
12.         TempArr(2) = TempArr(2) + arr(i, 3)
    
13. '这里1改为报销数额所在列对应列数
    
14.         TempArr(3) = TempArr(3) + 1
    
15.         d(arr(i, 1)) = TempArr
    
16.     Else
    
17.         ReDim TempArr(1 To 3)
    
18.         TempArr(1) = arr(i, 2)
    
19.         TempArr(2) = arr(i, 3)
    
20.         TempArr(3) = 1
    
21.         d.Add arr(i, 1), TempArr
    
22.     End If
    
23.     Erase TempArr
    
24. Next i
    
25. j = 2
    
26. For Each Hospital In d.keys
    
27.     Cells(j, "H") = Hospital ' 这里的H改为你打算放统计数据的列标签，以下类似
    
28.     Cells(j, "I").Resize(1, 3) = d(Hospital)
    
29.     j = j + 1
    
30. Next
    
31. End Sub
    

复制代码

feedyu

suye1010 发表于 2012-12-26 23:12

谢谢啊:){:081:}{:071:}

sh790512

我的表中数据不是和我排的一样，能不能把VBA改动一下？我的三列数据在不同列，最后统计

sh790512

suye1010 发表于 2012-12-26 23:12

谢谢老师指点，不过我脑子太笨。在数据少的看懂了。如果在我的表中，不知应该怎样改呢

sh790512

我的数据.rar (83.92 KB, 下载次数: 8)

2012-12-26 23:46 上传

点击文件名下载附件 我动不了脑子了，一想就晕，还是问老师吧

suye1010

1. Sub Summary()
   
2. Dim d, arr, TempArr, i As Integer, j As Integer, Hospital
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. arr = ActiveSheet.UsedRange
   
5. For i = 2 To UBound(arr)
   
6.     If d.exists(arr(i, 10)) Then
   
7.         TempArr = d(arr(i, 10))
   
8.         TempArr(1) = TempArr(1) + arr(i, 15)
   
9.         TempArr(2) = TempArr(2) + arr(i, 16)
   
10.         TempArr(3) = TempArr(3) + 1
    
11.         d(arr(i, 10)) = TempArr
    
12.     Else
    
13.         ReDim TempArr(1 To 3)
    
14.         TempArr(1) = arr(i, 15)
    
15.         TempArr(2) = arr(i, 16)
    
16.         TempArr(3) = 1
    
17.         d.Add arr(i, 10), TempArr
    
18.     End If
    
19.     Erase TempArr
    
20. Next i
    
21. j = 3
    
22. For Each Hospital In d.keys
    
23.     Cells(j, "AQ") = Hospital
    
24.     Cells(j, "AR").Resize(1, 3) = d(Hospital)
    
25.     j = j + 1
    
26. Next
    
27. End Sub
    

复制代码

sh790512

suye1010 发表于 2012-12-26 23:58

你好：我试了一下，统计的数据不正确，请给看一下谢谢 不好意思是我弄错了。谢谢你的支持帮助。祝您工作顺利。