[已解决]按条件汇总信息

ms967967

自己想了很久没做出来，请路过的老师帮忙。
求助按条件汇总信息。附件在楼下

最佳答案

月排行榜 / 总排行榜

grf1973

2015-4-22 11:26

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(1 To 100, 1 To 5)
   
4.     For j = 1 To UBound(arr, 2)
   
5.         If arr(1, j) = "乙" Then
   
6.             For i = 3 To UBound(arr)
   
7.                 If Len(arr(i, j)) > 0 Then
   
8.                     n = n + 1
   
9.                     brr(n, 1) = arr(2, j)
   
10.                     brr(n, 2) = arr(i, 1)
    
11.                     brr(n, 3) = arr(i, 2)
    
12.                     brr(n, 4) = arr(i, 3)
    
13.                     brr(n, 5) = arr(i, j)
    
14.                 End If
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     [a15].Resize(1, 5) = Array("日期", "名称1", "名称2", "名称3", "内容")
    
19.     [a16].Resize(n, 5) = brr
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

ms967967

按条件汇总信息.rar (8.91 KB, 下载次数: 11)

2015-4-21 21:25 上传

点击文件名下载附件

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(1 To 100, 1 To 5)
   
4.     For j = 1 To UBound(arr, 2)
   
5.         If arr(1, j) = "乙" Then
   
6.             For i = 3 To UBound(arr)
   
7.                 If Len(arr(i, j)) > 0 Then
   
8.                     n = n + 1
   
9.                     brr(n, 1) = arr(2, j)
   
10.                     brr(n, 2) = arr(i, 1)
    
11.                     brr(n, 3) = arr(i, 2)
    
12.                     brr(n, 4) = arr(i, 3)
    
13.                     brr(n, 5) = arr(i, j)
    
14.                 End If
    
15.             Next
    
16.         End If
    
17.     Next
    
18.     [a15].Resize(1, 5) = Array("日期", "名称1", "名称2", "名称3", "内容")
    
19.     [a16].Resize(n, 5) = brr
    
20. End Sub
    

复制代码