在一系列单元格上运行代码然后无限循环

Question

我正在制作一个 ping 监控工具。

我需要让它从第 2 行运行到第 207 行，然后循环回第 2 行并无限重复。

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

我尝试将“65536”更改为 207，但这只是破坏了整个事情。
我尝试将代码包装在另一个 For 循环中。

Answer 1

尝试这样的事情：

Sub PingSystems()
    Dim strip As String, rw As Long, wsData As Worksheet, res As Boolean
    
    Set wsData = ThisWorkbook.Worksheets("Systems") 'for example
    
    StatusCell.Value = "TESTING"
    
    Do
        For rw = 2 To wsData.Cells(65536, 2).End(xlUp).row
            DoEvents 'allow changes in cStatus
            If StatusCell.Value = "STOP" Then GoTo done
            With wsData.rows(rw).Cells(4)
                .Font.Color = vbBlack
                .Interior.ColorIndex = xlNone
                .Value = "Pinging..."
                DoEvents
                res = Ping(wsData.rows(rw).Cells(3).Value)
                .Interior.ColorIndex = IIf(res, 0, 6)
                .Font.Color = IIf(res, RGB(0, 200, 0), RGB(200, 0, 0))
                .Value = IIf(res, "Online", "Offline")
                Application.Wait (Now + TimeValue("0:00:01"))
            End With
        Next rw
    Loop

done:
    StatusCell.Value = "IDLE"
End Sub

Sub StopPing()
    StatusCell.Value = "STOP"
End Sub

Function StatusCell() As Range
    Set StatusCell = ThisWorkbook.Worksheets("Systems").Range("E2") 'for example
End Function

Function Ping(v) As Boolean
    Application.Wait (Now + TimeValue("0:00:01"))
    Ping = Rnd() > 0.1 'dummy test
End Function