Question

请问如何修改如下VBA代码计算出大于>0，小于<10的连续个数？

Sub 小于10的连续个数()
Dim aa(60000)
Set Rng = Selection(1)
a = Rng.Row
b = Rng.Column
Set Rng = Selection(Selection.Count)
c = Rng.Row
For i = a To c + 1
If Cells(i, b) < 10 Then
x = x + 1
Else
If x <> 0 Then
aa(K) = x
K = K + 1
End If
x = 0
End If
Next i
ii = 0
For j = 60000 To 0 Step -1
If aa(j) <> 0 Then
Cells(c - ii, b + 1) = aa(j)
ii = ii + 1
End If
Next j
End Sub
,

Answer 1

选中你的数据区，然后执行代码

Sub test()
Dim Arr, i As Integer, j As Integer
Arr = Selection: j = 0
For i = 1 To UBound(Arr, 1)
    If Arr(i, 1) > 0 And Arr(i, 1) < 10 Then
        j = j + 1: Arr(i, 1) = j
    Else
        j = 0: Arr(i, 1) = ""
    End If
Next
Selection.Offset(0, 1) = Arr
End Sub

Answer 2

已经可以了，只是显示的位置都在最后，是要增加颜色吗

追问

可是我执行后结果不对，你帮我修改一下吧，谢谢！不用加颜色的。

追答

选中数字以后执行，你看下行不行，我这边看好像没问题

追问

我执行后的结果，还有就是如果有负数或有零的时候，也计算出错误？

追答

两个地方，一个是把第一个for的+1去掉，第二个是在第一个next i后面增加一行    aa(K) = x。

还有就是优化建议，显示结果可以移到第一个for里面，黄色字体的旁边，这样看起来也醒目，还能减少一个60000次的循环。

Sub 小于10的连续个数()
    Set Rng = Selection(1)
    a = Rng.Row
    b = Rng.Column
    Set Rng = Selection(Selection.Count)
    c = Rng.Row
    For i = a To c
        If Cells(i, b) < 10 Then
            Cells(i, b).Interior.ColorIndex = 6
            x = x + 1
        Else
            If x <> 0 Then
                Cells(i - 1, b + 1) = x
            End If
            x = 0
        End If
    Next i
    Cells(i - 1, b + 1) = x
End Sub

追问

运行可以。可是我想把计算出的结果集中起来，而不是分散数值。能再修改一下吗

追答

如果结果要集中，只在原来代码基础上，按我说的改那两个地方就可以了