Excel VBA Ping监控工具：实现行2至207无限循环执行需求

我正在制作一款Ping监控工具，需要让它从第2行执行到第207行，之后循环回到第2行无限重复运行。将代码中的65536改为207后程序崩溃，尝试嵌套For循环也未解决问题。原VBA代码如下：

Sub PingSystem()
Dim strip As String
Do Until Sheet1.Range("E215").Value = "STOP"
Sheet1.Range("E215").Value = "TESTING"
For introw = 2 To ActiveSheet.Cells(65536, 2).End(xlUp).Row
    strip = ActiveSheet.Cells(introw, 3).Value
    If Ping(strip) = True Then
        ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 4).Font.Color = RGB(0, 0, 0)
        ActiveSheet.Cells(introw, 4).Value = "Online"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 4).Font.Color = RGB(0, 200, 0)
    Else
        ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 0
        ActiveSheet.Cells(introw, 4).Font.Color = RGB(200, 0, 0)
        ActiveSheet.Cells(introw, 4).Value = "Offline"
        Application.Wait (Now + TimeValue("0:00:01"))
        ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 6
    End If
    If Sheet1.Range("E215").Value = "STOP" Then
        Exit For
    End If
Next
Loop
Sheet1.Range("E215").Value = "IDLE"
End Sub

问题原因 #

原代码中ActiveSheet.Cells(207, 2).End(xlUp).Row的逻辑存在错误：当第207行非空时，End(xlUp)会向上查找最后一个非空单元格的行号，结果可能小于2，导致For循环的起始行大于结束行，触发运行时错误。

修复后的代码 #

直接固定遍历第2到207行，去掉动态查找行号的逻辑：

Sub PingSystem()
Dim strip As String
Do Until Sheet1.Range("E215").Value = "STOP"
    Sheet1.Range("E215").Value = "TESTING"
    ' 固定遍历第2到207行
    For introw = 2 To 207
        strip = ActiveSheet.Cells(introw, 3).Value
        If Ping(strip) = True Then
            ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 0
            ActiveSheet.Cells(introw, 4).Font.Color = RGB(0, 0, 0)
            ActiveSheet.Cells(introw, 4).Value = "Online"
            Application.Wait (Now + TimeValue("0:00:01"))
            ActiveSheet.Cells(introw, 4).Font.Color = RGB(0, 200, 0)
        Else
            ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 0
            ActiveSheet.Cells(introw, 4).Font.Color = RGB(200, 0, 0)
            ActiveSheet.Cells(introw, 4).Value = "Offline"
            Application.Wait (Now + TimeValue("0:00:01"))
            ActiveSheet.Cells(introw, 4).Interior.ColorIndex = 6
        End If
        ' 中途检测停止信号
        If Sheet1.Range("E215").Value = "STOP" Then
            Exit For
        End If
    Next
Loop
Sheet1.Range("E215").Value = "IDLE"
End Sub

说明 #

• 直接指定For introw = 2 To 207，确保每次循环都遍历固定行范围
• 保留原有的停止检测逻辑，可通过在E215单元格输入"STOP"终止程序
• 保留了Ping状态的颜色提示和1秒延迟，确保监控效果直观

内容的提问来源于stack exchange，提问作者gpiguy