改写语句求出各数据的百分比？

雪枫少爷

麻烦各位帮忙该写一下下面的语句啊 ，比如说查询文档1在 上 这个等级有8个数据，在整个名为属性的工作表里共有23个数据
其百分比 为34.78%，如上所诉求出每个数据的百分比。即求出每个所涉及属性一共有多少数据，比如说在名为属性的工作表中涉及到查询文档1这个属性的数据有23个，在23个中有8个数据满足上这个等级的特征，求满足上这个等级的数据占所涉及到查询文档1的百分比是多少，后面附件有效果图，谢谢各位了啊  非常的感谢！！！！！！！！！！！！
ub 查询()
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
For k = 1 To 2
arr = Sheets(k).[a1].CurrentRegion
For i = 2 To UBound(arr)
d(arr(i, 4)) = ""
d1(arr(i, 4) & arr(i, 1)) = d1(arr(i, 4) & arr(i, 1)) + 1
Next
Next
With Sheets(3)
  .[a:d].Clear
  .[a1].Resize(1, 4) = Array("所涉及", "上", "中", "下")
  .[a2].Resize(d.Count) = Application.Transpose(d.keys)
brr = .[a1].CurrentRegion
For i = 2 To UBound(brr)
For j = 2 To UBound(brr, 2)
brr(i, j) = d1(brr(i, 1) & brr(1, j))
Next
Next
.[a1].CurrentRegion = brr
End With
End Sub

dsmch

1. Sub 查询()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     Set d1 = CreateObject("scripting.dictionary")
   
4.     w = Array("所涉及", "上", "", "中", "", "下", "")
   
5.     For k = 1 To 2
   
6.         arr = Sheets(k).[a1].CurrentRegion
   
7.         For i = 2 To UBound(arr)
   
8.             d(arr(i, 4)) = d(arr(i, 4)) + 1
   
9.             d1(arr(i, 4) & arr(i, 1)) = d1(arr(i, 4) & arr(i, 1)) + 1
   
10.         Next
    
11.     Next
    
12.     With Sheets(3)
    
13.         .[a:g].Clear
    
14.         .[a1].Resize(1, 7) = w
    
15.         .[a2].Resize(d.Count) = Application.Transpose(d.keys)
    
16.         brr = .[a1].Resize(d.Count + 1, UBound(w) + 1)
    
17.         For i = 2 To UBound(brr)
    
18.             For j = 2 To UBound(brr, 2) - 1 Step 2
    
19.                 brr(i, j) = d1(brr(i, 1) & brr(1, j))
    
20.                 brr(i, j + 1) = Format(brr(i, j) / d(brr(i, 1)), "0.00%")
    
21.             Next
    
22.         Next
    
23.         .[a1].Resize(UBound(brr), UBound(brr, 2)) = brr
    
24.     End With
    
25. End Sub

复制代码

fjmxwrs

附件
增加一个字典来统计总个数即可

雪枫少爷

fjmxwrs 发表于 2016-6-19 18:02
附件
增加一个字典来统计总个数即可

非常的感谢你这就是我想要的效果啊