[已解决]VBA数组直接调用AF列数据过滤相连组数

laoau138

VBA数组直接调用AF列数据过滤相连组数

最佳答案

月排行榜 / 总排行榜

france723

2017-5-29 17:18

laoau138 发表于 2017-5-28 18:25
其实好简单，把A：F列数据每一行，相连号组数过滤就可以

1,2,3,4,5,6 一行6个数字   一共有5组相连

1. Sub aaa()
   
2. Dim y, ar, i&, s1, s2, j&, n, m, br, p
   
3. y = Range("a65536").End(3).Row
   
4. ar = Range("a11:f" & y)
   
5. s1 = [H11]
   
6. s2 = [J11]
   
7. q = 11
   
8. For i = 1 To UBound(ar)
   
9.     n = 0
   
10.     p = 1
    
11.     For j = 2 To UBound(ar, 2)
    
12.         If ar(i, j) - ar(i, j - 1) = 1 Then
    
13.             n = n + 1
    
14.         End If
    
15.     Next j
    
16.     If n = s1 Or n = s2 Then
    
17.         ReDim br(1 To UBound(ar, 2))
    
18.         For m = 1 To UBound(ar, 2)
    
19.             br(p) = ar(i, m)
    
20.             p = p + 1
    
21.         Next m
    
22.         Range("l" & q).Resize(1, UBound(br)) = br
    
23.         q = q + 1
    
24.     End If
    
25. Next i
    
26. End Sub

复制代码

跳转到最佳答案楼层

france723

说实话，没看懂....

laoau138

france723 发表于 2017-5-28 17:15
说实话，没看懂....

其实好简单，把A：F列数据每一行，相连号组数过滤就可以

1,2,3,4,5,6 一行6个数字   一共有5组相连
1，2 一组相连     2，3一组相连  3，4一组相连    4，5一组相连    5，6一组相连      


现在题目只保留相连号 1组或2组   ,那么一行含有3组，4组，5组就过滤不要了

2

4

6

7

9

10

.......................................................................................这个含有2组相连，6和7一组相连，9和10相连

1

3

6

7

9

10

......................................................................................这个含有1组相连，9和10相连

.................................................................................所以L：Q列这两行都保留下来了

1   2    3    4     9   10.....................................这个含有3组相连,  1和2相连， 2和3相连，   3和4相连........................所以被过滤L:Q列找不到这一行

laoau138

france723 发表于 2017-5-28 17:15
说实话，没看懂....

VBA数组直接调用AF列数据过滤相连组数+怎样写

france723

laoau138 发表于 2017-5-28 18:25
其实好简单，把A：F列数据每一行，相连号组数过滤就可以

1,2,3,4,5,6 一行6个数字   一共有5组相连

1. Sub aaa()
   
2. Dim y, ar, i&, s1, s2, j&, n, m, br, p
   
3. y = Range("a65536").End(3).Row
   
4. ar = Range("a11:f" & y)
   
5. s1 = [H11]
   
6. s2 = [J11]
   
7. q = 11
   
8. For i = 1 To UBound(ar)
   
9.     n = 0
   
10.     p = 1
    
11.     For j = 2 To UBound(ar, 2)
    
12.         If ar(i, j) - ar(i, j - 1) = 1 Then
    
13.             n = n + 1
    
14.         End If
    
15.     Next j
    
16.     If n = s1 Or n = s2 Then
    
17.         ReDim br(1 To UBound(ar, 2))
    
18.         For m = 1 To UBound(ar, 2)
    
19.             br(p) = ar(i, m)
    
20.             p = p + 1
    
21.         Next m
    
22.         Range("l" & q).Resize(1, UBound(br)) = br
    
23.         q = q + 1
    
24.     End If
    
25. Next i
    
26. End Sub

复制代码