[已解决]求助数据罗列

emmahhm

各位大神，帮帮忙！
需要把满足需求的数据罗列出来。详见附件！

最佳答案

月排行榜 / 总排行榜

grf1973

2016-6-23 14:27

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(2 To UBound(arr), 1 To UBound(arr))
   
4.     For i = 2 To UBound(arr)
   
5.         brr(i, 1) = arr(i, 1)
   
6.         If arr(i, 3) = "N" Then
   
7.             brr(i, 2) = "无"
   
8.         Else
   
9.             n = 1
   
10.             ai = Left(arr(i, 2), Len(arr(i, 2)) - 1)
    
11.             bi = Val(Right(arr(i, 2), 1))
    
12.             For j = 2 To UBound(arr)
    
13.                 aj = Left(arr(j, 2), Len(arr(j, 2)) - 1)
    
14.                 bj = Val(Right(arr(j, 2), 1))
    
15.                 If ai = aj And bi < bj Then
    
16.                     n = n + 1
    
17.                     If nmax < n Then nmax = n
    
18.                     brr(i, n) = arr(j, 1)
    
19.                 End If
    
20.             Next
    
21.             If n = 1 Then brr(i, 2) = "无"
    
22.         End If
    
23.     Next
    
24.     [f2].Resize(i - 2, nmax) = brr
    
25. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()
   
2.     arr = [a1].CurrentRegion
   
3.     ReDim brr(2 To UBound(arr), 1 To UBound(arr))
   
4.     For i = 2 To UBound(arr)
   
5.         brr(i, 1) = arr(i, 1)
   
6.         If arr(i, 3) = "N" Then
   
7.             brr(i, 2) = "无"
   
8.         Else
   
9.             n = 1
   
10.             ai = Left(arr(i, 2), Len(arr(i, 2)) - 1)
    
11.             bi = Val(Right(arr(i, 2), 1))
    
12.             For j = 2 To UBound(arr)
    
13.                 aj = Left(arr(j, 2), Len(arr(j, 2)) - 1)
    
14.                 bj = Val(Right(arr(j, 2), 1))
    
15.                 If ai = aj And bi < bj Then
    
16.                     n = n + 1
    
17.                     If nmax < n Then nmax = n
    
18.                     brr(i, n) = arr(j, 1)
    
19.                 End If
    
20.             Next
    
21.             If n = 1 Then brr(i, 2) = "无"
    
22.         End If
    
23.     Next
    
24.     [f2].Resize(i - 2, nmax) = brr
    
25. End Sub
    

复制代码

emmahhm

谢谢，完美解决我的问题