[已解决]按条件提取不同的。

left369

按条件提取不同的。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-11-22 21:38

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, p$$, s%
   
3. arr = Range("b17").CurrentRegion
   
4. ReDim brr(1 To 10, 1 To UBound(arr, 2))
   
5. For j = 1 To UBound(arr, 2)
   
6.     p = "": s = 0
   
7.     For i = UBound(arr) To 1 Step -1
   
8.         If InStr(p, arr(i, j)) = 0 Then
   
9.             s = s + 1
   
10.             brr(s, j) = arr(i, j)
    
11.             p = p & arr(i, j)
    
12.         End If
    
13.     Next
    
14. Next
    
15. Range("b52").Resize(10, UBound(brr, 2)) = brr
    
16. End Sub

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, i&, j%, p$$, s%
   
3. arr = Range("b17").CurrentRegion
   
4. ReDim brr(1 To 10, 1 To UBound(arr, 2))
   
5. For j = 1 To UBound(arr, 2)
   
6.     p = "": s = 0
   
7.     For i = UBound(arr) To 1 Step -1
   
8.         If InStr(p, arr(i, j)) = 0 Then
   
9.             s = s + 1
   
10.             brr(s, j) = arr(i, j)
    
11.             p = p & arr(i, j)
    
12.         End If
    
13.     Next
    
14. Next
    
15. Range("b52").Resize(10, UBound(brr, 2)) = brr
    
16. End Sub

复制代码