[已解决]用VAB把分类汇总的数据提取出来

hui3643616

把分类汇总的数据提取出来，还需要加点工
详细内容和要求在附表里面
求高手解决！

最佳答案

月排行榜 / 总排行榜

grf1973

2017-7-24 16:36

1. Sub tt()
   
2.     arr = Sheet1.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     ReDim brr(1 To UBound(arr), 1 To 3)
   
5.     For i = 3 To UBound(arr)
   
6.         x = arr(i, 6): p = IIf(arr(i, 9) = "属实", 2, 3)
   
7.         If Not d.exists(x) Then
   
8.             n = n + 1: d(x) = n
   
9.             brr(n, 1) = x
   
10.         End If
    
11.         brr(d(x), p) = brr(d(x), p) + 1
    
12.     Next
    
13.     For i = 1 To n
    
14.         x = Val(brr(i, 2)): y = Val(brr(i, 3))
    
15.         brr(i, 2) = "不属实的" & y & "条属实的" & x & "条"
    
16.         brr(i, 3) = x + y & "条"
    
17.     Next
    
18.     With Sheet2
    
19.         .[a2].Resize(1000, 3).ClearContents
    
20.         .[a2].Resize(n, 3) = brr
    
21.         .Activate
    
22.     End With
    
23. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     arr = Sheet1.[a1].CurrentRegion
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     ReDim brr(1 To UBound(arr), 1 To 3)
   
5.     For i = 3 To UBound(arr)
   
6.         x = arr(i, 6): p = IIf(arr(i, 9) = "属实", 2, 3)
   
7.         If Not d.exists(x) Then
   
8.             n = n + 1: d(x) = n
   
9.             brr(n, 1) = x
   
10.         End If
    
11.         brr(d(x), p) = brr(d(x), p) + 1
    
12.     Next
    
13.     For i = 1 To n
    
14.         x = Val(brr(i, 2)): y = Val(brr(i, 3))
    
15.         brr(i, 2) = "不属实的" & y & "条属实的" & x & "条"
    
16.         brr(i, 3) = x + y & "条"
    
17.     Next
    
18.     With Sheet2
    
19.         .[a2].Resize(1000, 3).ClearContents
    
20.         .[a2].Resize(n, 3) = brr
    
21.         .Activate
    
22.     End With
    
23. End Sub

复制代码