Перечень макросов Excel VBA

Question

Я хотел бы использовать макрос VBA для копирования веб-страницы (https://weather.gc.ca/warnings/index_e.html) в электронную таблицу Excel - все, что я хочу скопировать, - это раздел, в котором есть таблица, начинающаяся с Location, Warning, Watch, Statement

Каждый раз, когда я пишу что-то, оно копируется поверх

Первые несколько строк дают мне это:

Первая проблема - когда появляется предупреждение WindWind ... Я ищу его, чтобы скопировать его, так как он находится вне веб-сайта, на котором просто написано "Ветер", "Дождь", "Особая погода" и т. Д ... не все

Сценарий, который я использую, выглядит следующим образом:

Option Explicit
Sub Web_Table_Option_One()
    Dim xml    As Object
    Dim html   As Object
    Dim objTable As Object
    Dim result As String
    Dim lRow As Long
    Dim lngTable As Long
    Dim lngRow As Long
    Dim lngCol As Long
    Dim ActRw As Long
    Set xml = CreateObject("MSXML2.XMLHTTP.6.0")

     ThisWorkbook.Sheets("Sheet2").Cells.ClearContents
    With xml
        .Open "GET", "https://weather.gc.ca/warnings/index_e.html", False
        .send
    End With
    result = xml.responseText
    Set html = CreateObject("htmlfile")
    html.body.innerHTML = result
    Set objTable = html.getElementsByTagName("Table")
    For lngTable = 0 To objTable.Length - 1
        For lngRow = 0 To objTable(lngTable).Rows.Length - 1
            For lngCol = 0 To objTable(lngTable).Rows(lngRow).Cells.Length - 1
                ThisWorkbook.Sheets("Sheet2").Cells(ActRw + lngRow + 1, lngCol + 1) = objTable(lngTable).Rows(lngRow).Cells(lngCol).innerText
            Next lngCol
        Next lngRow
        ActRw = ActRw + objTable(lngTable).Rows.Length + 1
    Next lngTable
End Sub

Answer 1

Похоже, что это работает для меня, как указано в комментариях рассмотреть возможность использования API.

Этот подход находит таблицу, копирует ее в буфер обмена, а затем вставляет всю таблицу за один раз.

Option Explicit
Sub Web_Table_Option_One()
    Dim html        As Object: Set html = CreateObject("htmlfile")
    Dim result      As String
    Dim Clip        As Object: Set Clip = CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

    With CreateObject("MSXML2.XMLHTTP.6.0")
        .Open "GET", "https://weather.gc.ca/warnings/index_e.html", False
        .send
        result = .responseText
    End With

    If Len(result) > 0 Then html.body.innerhtml = result

    Clip.SetText html.getElementsByTagName("table")(0).outerhtml
    Clip.PutInClipboard

    With ThisWorkbook.Sheets("Sheet2")
        .Cells.ClearContents
        .Range("A1").Select
        .PasteSpecial Format:="Unicode Text"
    End With
End Sub