[已解决]求利用VBA生成一个表格

epsonstar

单位要统计一个内容随时更新的表，听说VBA很方便，本人菜鸟，特求大侠帮忙： Book2.zip (61.92 KB, 下载次数: 14)

2014-4-21 17:00 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-21 19:20

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr(1 To 20000, 1 To 5), d, i&, s&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. For i = 3 To UBound(arr)
   
6.     If arr(i, 4) = "" Then arr(i, 4) = arr(i - 1, 4)
   
7.     Set rng = Sheet1.Cells(i, "k").Resize(1, 10).Find("*")
   
8.     If Not rng Is Nothing Then
   
9.         If Not d.exists(arr(i, 4)) Then
   
10.             s = s + 1
    
11.             d(arr(i, 4)) = s
    
12.             brr(s, 1) = arr(i, 1)
    
13.             brr(s, 2) = arr(i, 4)
    
14.             brr(s, 3) = rng
    
15.             brr(s, 4) = arr(i, 21)
    
16.             brr(s, 5) = arr(i, 22)
    
17.         Else
    
18.             brr(d(arr(i, 4)), 3) = brr(d(arr(i, 4)), 3) & "/" & rng
    
19.             If arr(i, 21) <> "" Then
    
20.                 brr(d(arr(i, 4)), 4) = brr(d(arr(i, 4)), 4) & "/" & arr(i, 21)
    
21.                 brr(d(arr(i, 4)), 5) = brr(d(arr(i, 4)), 5) & "/" & arr(i, 22)
    
22.             End If
    
23.         End If
    
24.     End If
    
25. Next
    
26. Sheet2.Activate
    
27. Range("a2").Resize(s, 5) = brr
    
28. End Sub
    

复制代码

dsmch

………………