очистить данные из таблицы на сайте без необходимости поиска тегов

Question

это продолжение этого вопроса использование InStr для поиска кавычек, пробелов, двоеточий и т. Д.

Я также пытаюсь получить все эти данные ниже.Я собирался сделать цикл, который будет искать <td align="left">, но у меня есть ощущение, что он принесет тонну мусора вместе с нужными мне результатами.мне интересно, есть ли лучший способ сделать это.

<b>Total Hospital Beds</b></td> 
                                        <td align="left">Adult ICU (intensive care unit) CCU (critical care unit)</td>
                                        <td align="left">26</td>
                                        <td align="left">Medical/surgical</td>
                                        <td align="left">198</td>
                                        <td align="left">Pediatric</td>
                                        <td align="left">20</td>

                                        <td align="center" colspan="2"><b>Services</b></td>
                                        <td align="left">Acute Hemodialoysis Service</td>
                                        <td align="left">Chronic Hemodialysis Stations</td>
                                        <td align="left">Magnetic Resonance Imaging - On Site</td>
                                        <td align="left">Mixed OR's</td>
                                        <td align="left">7</td>

в основном, все в разделе внизу, скриншот прилагается

Этоэто то, что у меня есть, но теперь оно останавливается после первой страницы, жирная линия выделяется

Public Sub VisitPages()
    Dim IE As New InternetExplorer
    With IE
        .Visible = True
        .navigate "http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county"

        While .Busy Or .ReadyState < 4: DoEvents: Wend

        With .Document
            .querySelector("#middleContent_cbType_1").Click
            .querySelector("#middleContent_cbType_4").Click
            .querySelector("#middleContent_btnGetList").Click
        End With

        While .Busy Or .ReadyState < 4: DoEvents: Wend

        Dim list As Object, i  As Long
        Set list = .Document.querySelectorAll("#main_table [href*=doPostBack]")

        For i = 0 To list.Length - 1

            list.Item(i).Click

            While .Busy Or .ReadyState < 4: DoEvents: Wend

            ' Application.Wait Now + TimeSerial(0, 0, 3) '<== Delete me later. This is just to demo page changes
            **Debug.Print .Document.getElementById("middleContent_lbName_county").outerHTML**
            'do stuff with new page

            Dim FirstOcc As Long
            Dim TtlHosp As Variant
            Dim FLine As Variant
            Dim FLineFixed As Variant

            TtlHosp = Mid(.Document.Body.innerHTML, InStr(.Document.Body.innerHTML, "Total Hospital Beds"), 4000)

            Do Until InStr(TtlHosp, "<td align=" & Chr(34) & "left" & Chr(34) & ">") = 0

                FirstOcc = InStr(TtlHosp, "<td align=" & Chr(34) & "left" & Chr(34) & ">")
                FLine = Mid(TtlHosp, FirstOcc + 17, 150)
                FLineFixed = Mid(FLine, 1, InStr(FLine, "</td>") - 1)
                Debug.Print FLineFixed
                TtlHosp = Mid(TtlHosp, FirstOcc + 17, 2000)

            Loop

            .Navigate2 .Document.URL             '<== back to homepage
            While .Busy Or .ReadyState < 4: DoEvents: Wend
            Set list = .Document.querySelectorAll("#main_table [href*=doPostBack]") 'reset list (often required in these scenarios)
        Next
        Stop                                     '<== Delete me later
        '.Quit '<== Remember to quit application
    End With
End Sub

Answer 1

Похоже, что информация предназначена только для специального выбора больницы, а информация о койках находится в третьей таблице.(Примечание: результаты в настоящее время написаны в Excel)

Option Explicit
Public Sub VisitPages()
    Dim IE As New InternetExplorer, ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    With IE
        .Visible = True
        .navigate "http://healthapps.state.nj.us/facilities/acSetSearch.aspx?by=county"

        While .Busy Or .readyState < 4: DoEvents: Wend

        With .document
            .querySelector("#middleContent_cbType_5").Click
            .querySelector("#middleContent_btnGetList").Click
        End With

        While .Busy Or .readyState < 4: DoEvents: Wend

        Dim list As Object, i  As Long
        Set list = .document.querySelectorAll("#main_table [href*=doPostBack]")
        For i = 0 To list.Length - 1
            list.item(i).Click

            While .Busy Or .readyState < 4: DoEvents: Wend

            WriteTable .document.getElementsByTagName("table")(3), .document.getElementById("middleContent_lbName_county").innerText, GetLastRow(ws, 3) + 1, ws
            'do stuff with new page
            .Navigate2 .document.URL             '<== back to homepage
            While .Busy Or .readyState < 4: DoEvents: Wend
            Set list = .document.querySelectorAll("#main_table [href*=doPostBack]") 'reset list (often required in these scenarios)
        Next
        .Quit                                    '<== Remember to quit application
    End With
End Sub

Public Function GetLastRow(ByVal ws As Worksheet, Optional ByVal columnNumber As Long = 1) As Long
    With ws
        GetLastRow = .Cells(.Rows.Count, columnNumber).End(xlUp).Row
    End With
End Function

Public Sub WriteTable(ByVal hTable As HTMLTable, facility As String, Optional ByVal startRow As Long = 1, Optional ByVal ws As Worksheet)
    If ws Is Nothing Then Set ws = ActiveSheet

    Dim tRow As Object, tCell As Object, tr As Object, td As Object, r As Long, c As Long, titleRow As Long
    r = startRow: titleRow = startRow
    With ws
        Set tRow = hTable.getElementsByTagName("tr")
        .Cells(titleRow, 1) = facility
        For Each tr In tRow
            r = r + 1
            Set tCell = tr.getElementsByTagName("td")
            c = 2
            For Each td In tCell
                .Cells(r, c).Value = td.innerText
                c = c + 1
            Next td
        Next tr
    End With
End Sub