[已解决]关于选择单元格没有连续数值的行，或者只有一组连续2个数值的行

ttbb523

求大虾用vba解决，附上附件一份，谢谢

最佳答案

月排行榜 / 总排行榜

dsmch

2016-4-6 15:18

1. Sub Macro1()
   
2. Dim arr, brr, crr, i&, j%
   
3. arr = [a1:f17]
   
4. ReDim brr(1 To 20000, 1 To 6)
   
5. ReDim crr(1 To 20000, 1 To 6)
   
6. For i = 1 To UBound(arr)
   
7.     s = 0
   
8.     For j = 2 To UBound(arr, 2)
   
9.         If arr(i, j) - arr(i, j - 1) = 1 Then s = s + 1
   
10.     Next
    
11.     If s = 1 Then
    
12.         n = n + 1
    
13.         For j = 1 To UBound(arr, 2)
    
14.             brr(n, j) = arr(i, j)
    
15.         Next
    
16.     End If
    
17.     If s = 0 Then
    
18.         n2 = n2 + 1
    
19.         For j = 1 To UBound(arr, 2)
    
20.             crr(n2, j) = arr(i, j)
    
21.         Next
    
22.     End If
    
23. Next
    
24. If n Then Range("i1").Resize(n, 6) = brr
    
25. If n2 Then Range("q1").Resize(n2, 6) = crr
    
26. End Sub

复制代码

跳转到最佳答案楼层

七彩屋

可以使用循环进行判断，然后将结果逐个写入目标单元格。

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, crr, i&, j%
   
3. arr = [a1:f17]
   
4. ReDim brr(1 To 20000, 1 To 6)
   
5. ReDim crr(1 To 20000, 1 To 6)
   
6. For i = 1 To UBound(arr)
   
7.     s = 0
   
8.     For j = 2 To UBound(arr, 2)
   
9.         If arr(i, j) - arr(i, j - 1) = 1 Then s = s + 1
   
10.     Next
    
11.     If s = 1 Then
    
12.         n = n + 1
    
13.         For j = 1 To UBound(arr, 2)
    
14.             brr(n, j) = arr(i, j)
    
15.         Next
    
16.     End If
    
17.     If s = 0 Then
    
18.         n2 = n2 + 1
    
19.         For j = 1 To UBound(arr, 2)
    
20.             crr(n2, j) = arr(i, j)
    
21.         Next
    
22.     End If
    
23. Next
    
24. If n Then Range("i1").Resize(n, 6) = brr
    
25. If n2 Then Range("q1").Resize(n2, 6) = crr
    
26. End Sub

复制代码

ttbb523

谢谢