Выполнение этого кода VBA только для видимых данных после фильтрации - PullRequest
0 голосов
/ 01 апреля 2020

Мне нужен этот код, чтобы работать только с отфильтрованными данными в таблице Excel. Помогите! Этот код проверяет IP-адреса в одном столбце, а выводит результат в другом столбце, теперь мне нужно работать только с теми IP-адресами, которые отображаются после фильтрации. Если кто-то знает, что добавить, чтобы добиться этого, это будет отличной помощью.

    Function GetPingResult(Host)

       Dim objPing As Object
       Dim objStatus As Object
       Dim strResult As String

       Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
           ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")

       For Each objStatus In objPing
          Select Case objStatus.StatusCode
             Case 0: strResult = "Connected"
             Case 11001: strResult = "Buffer too small"
             Case 11002: strResult = "Destination net unreachable"
             Case 11003: strResult = "Destination host unreachable"
             Case 11004: strResult = "Destination protocol unreachable"
             Case 11005: strResult = "Destination port unreachable"
             Case 11006: strResult = "No resources"
             Case 11007: strResult = "Bad option"
             Case 11008: strResult = "Hardware error"
             Case 11009: strResult = "Packet too big"
             Case 11010: strResult = "Request timed out"
             Case 11011: strResult = "Bad request"
             Case 11012: strResult = "Bad route"
             Case 11013: strResult = "Time-To-Live (TTL) expired transit"
             Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
             Case 11015: strResult = "Parameter problem"
             Case 11016: strResult = "Source quench"
             Case 11017: strResult = "Option too big"
             Case 11018: strResult = "Bad destination"
             Case 11032: strResult = "Negotiating IPSEC"
             Case 11050: strResult = "General failure"
             Case Else: strResult = "Unknown host"
          End Select
          GetPingResult = strResult
       Next

       Set objPing = Nothing

    End Function

    Sub GetIPStatus()

      Dim Cell As Range
      Dim ipRng As Range
      Dim Result As String
      Dim Wks As Worksheet


    Set Wks = Worksheets("Sheet1")

    Set ipRng = Wks.Range("F2")
    Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
    Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))

      For Each Cell In ipRng
        Result = GetPingResult(Cell)
        test = IsEmpty(Cell.Value)
        If test = True Then
            Cell.Offset(0, 3) = "No IP Address"
            Result = "No IP Address"
        Else
            Cell.Offset(0, 3) = Result
        End If

        If Result = "Connected" Then
            Cell.Offset(0, 3).Font.Color = vbGreen
        Else
            Cell.Offset(0, 3).Font.Color = vbRed

        End If
      Next Cell

    End Sub

1 Ответ

0 голосов
/ 01 апреля 2020

Использование Range.SpecialCells(xlCellTypeVisible).

Изменить

For Each Cell In ipRng

на

For Each Cell in ipRng.SpecialCells(xlCellTypeVisible)
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...