[已解决]求助大神解决

ttbb523

求助大神解决1，删除全是单数或者双数的行，
                     2，选出尾数只有一组重复且只重复2次的行
如果可以麻烦给注释下程序的详细功能

最佳答案

月排行榜 / 总排行榜

grf1973

2016-4-8 16:46

1. Sub tt()     '删除全是单数或者双数的行
   
2.     arr = [a1:f17]
   
3.     c = UBound(arr, 2)
   
4.     For i = 1 To UBound(arr)
   
5.         x = 0
   
6.         For j = 1 To c
   
7.             x = x + arr(i, j) Mod 2
   
8.         Next
   
9.         If x <> 0 And x <> c Then
   
10.             n = n + 1
    
11.             For j = 1 To c
    
12.                 arr(n, j) = arr(i, j)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     [h1].Resize(100, c) = ""
    
17.     [h1].Resize(n, c) = arr
    
18. End Sub
    
19. Sub ttt()     '选出尾数只有一组重复2次的行
    
20.     arr = [a1:f17]
    
21.     Set d = CreateObject("scripting.dictionary")
    
22.     c = UBound(arr, 2)
    
23.     For i = 1 To UBound(arr)
    
24.         d.RemoveAll
    
25.         For j = 1 To c
    
26.             x = arr(i, j) Mod 10
    
27.             d(x) = ""
    
28.         Next
    
29.         If d.Count = c - 1 Then
    
30.             n = n + 1
    
31.             For j = 1 To c
    
32.                 arr(n, j) = arr(i, j)
    
33.             Next
    
34.         End If
    
35.     Next
    
36.     [q1].Resize(100, c) = ""
    
37.     [q1].Resize(n, c) = arr
    
38. End Sub

复制代码

跳转到最佳答案楼层

grf1973

1. Sub tt()     '删除全是单数或者双数的行
   
2.     arr = [a1:f17]
   
3.     c = UBound(arr, 2)
   
4.     For i = 1 To UBound(arr)
   
5.         x = 0
   
6.         For j = 1 To c
   
7.             x = x + arr(i, j) Mod 2
   
8.         Next
   
9.         If x <> 0 And x <> c Then
   
10.             n = n + 1
    
11.             For j = 1 To c
    
12.                 arr(n, j) = arr(i, j)
    
13.             Next
    
14.         End If
    
15.     Next
    
16.     [h1].Resize(100, c) = ""
    
17.     [h1].Resize(n, c) = arr
    
18. End Sub
    
19. Sub ttt()     '选出尾数只有一组重复2次的行
    
20.     arr = [a1:f17]
    
21.     Set d = CreateObject("scripting.dictionary")
    
22.     c = UBound(arr, 2)
    
23.     For i = 1 To UBound(arr)
    
24.         d.RemoveAll
    
25.         For j = 1 To c
    
26.             x = arr(i, j) Mod 10
    
27.             d(x) = ""
    
28.         Next
    
29.         If d.Count = c - 1 Then
    
30.             n = n + 1
    
31.             For j = 1 To c
    
32.                 arr(n, j) = arr(i, j)
    
33.             Next
    
34.         End If
    
35.     Next
    
36.     [q1].Resize(100, c) = ""
    
37.     [q1].Resize(n, c) = arr
    
38. End Sub

复制代码

ttbb523

非常漂亮，速度也很快，谢谢