Option Explicit
Option Compare Text
''' объект objHTMLDoc As HTMLDocument, объявлен ранним связыванием
''' Tools -> References -> Microsoft HTML Object Library. > C:\Windows\SysWOW64\mshtml.tlb
''' Для примера страница сайта с которой берем данные
Private Const strURL As String = " https://meteoinfo.ru/forecasts/russia/vologda-area/vologda"
 
Sub Parser_meteoinfo1 ()
Dim objHTMLDoc As HTMLDocument
Dim objXML As Object, Tag1, vl1, vl2
Dim strOtvetAukcion As String, strTrimer As String
Dim arr(), i As Long, x As Long

Set objHTMLDoc = New HTMLDocument
Set objXML = CreateObject("MSXML2.XMLHTTP.6.0")
objXML.Open "GET", strURL, False
objXML.setRequestHeader "Accept", "*/*"
objXML.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:49.0) Gecko/20100101 Firefox/58.0.1"
objXML.setRequestHeader "Proxy-Connection", "Keep-Alive"
objXML.setRequestHeader "Cache-Control", "no-cache"
objXML.setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
objXML.setRequestHeader "Content-Type", "text/xml"
objXML.sEnd
While objXML.readyState <> 4: DoEvents: Wend
objHTMLDoc.body.innerHTML = objXML.responseText

''' набор данных
Set Tag1 = objHTMLDoc.getElementsByTagName("tr")
ReDim arr(1 To Tag1.Length, 1 To 2)
arr(1, 1) = "Осадки, день"
arr(1, 2) = "Ветер, м/с"

For Each vl1 In Tag1
  If vl1.innerHTML Like "*fc_small_gorizont_ww*" Then
    If vl1.innerHTML Like "*День*" Then
    ' извлечь данные по облачности и осадкам
      i = 1: x = 1
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "День" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" Then
    ' извлечь направление ветра, скорость
      i = 1: x = 2
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "Ветер, м/с" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
  End If
  If x = 2 Then Exit For
Next
'' Поместить результат запроса на лист
ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Set objHTMLDoc = Nothing
Set objXML = Nothing
End Sub

Option Explicit
Option Compare Text
''' объект objHTMLDoc As HTMLDocument, объявлен ранним связыванием
''' Tools -> References -> Microsoft HTML Object Library. > C:\Windows\SysWOW64\mshtml.tlb

Sub Parser_meteoinfo()
Dim objHTMLDoc As HTMLDocument
Dim objXML As Object, Tag1, vl1, vl2
Dim strOtvetAukcion As String, strTrimer As String
Dim arr(), i As Long, x As Long

''' страница сайта с которой берем данные
Dim strURL As String
strURL = "https://meteoinfo.ru/forecasts/russia/vologda-area/vologda"

Set objHTMLDoc = New HTMLDocument
Set objXML = CreateObject("MSXML2.XMLHTTP.6.0")
objXML.Open "GET", strURL, False
objXML.setRequestHeader "Accept", "*/*"
objXML.setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:49.0) Gecko/20100101 Firefox/58.0.1"
objXML.setRequestHeader "Proxy-Connection", "Keep-Alive"
objXML.setRequestHeader "Cache-Control", "no-cache"
objXML.setRequestHeader "If-Modified-Since", "Thu, 1 Jan 1970 00:00:00 UTC"
objXML.setRequestHeader "Content-Type", "text/xml"
objXML.sEnd
While objXML.readyState <> 4: DoEvents: Wend
objHTMLDoc.body.innerHTML = objXML.responseText

''' набор данных
Set Tag1 = objHTMLDoc.getElementsByTagName("tr")
ReDim arr(1 To Tag1.Length, 1 To 4)
arr(1, 1) = "Осадки, день"
arr(1, 2) = "Ветер, м/с"
arr(1, 3) = "Осадки, ночь"
arr(1, 4) = "Ветер, м/с"

For Each vl1 In Tag1
  If vl1.innerHTML Like "*fc_small_gorizont_ww*" Then
    Debug.Print vbNewLine
    Debug.Print vl1.innerHTML
    If vl1.innerHTML Like "*День*" Then
    ' извлечь данные по облачности и осадкам
      i = 1: x = 1
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "День" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" And _
    Not vl1.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
    ' извлечь направление ветра, скорость
      i = 1: x = 2
      For Each vl2 In vl1.Cells
        If vl2.innerText <> "Ветер, м/с" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
    
    If vl1.innerHTML Like "*Ночь*" Then
    ' извлечь данные по облачности и осадкам за ночь
      i = 1: x = 3
      For Each vl2 In vl1.Cells
        If vl2.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title
        End If
      Next
    End If
    If vl1.innerHTML Like "*Ветер, м/с*" And _
       vl1.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
    ' извлечь направление ветра, скорость за ночь
      i = 1: x = 4
      For Each vl2 In vl1.Cells
        If vl2.innerHTML Like "*fc_small_gorizont_ww sdvig_div*" Then
          i = i + 1
          arr(i, x) = vl2.Children.Item(0).Children.Item(0).Title & ", " & vl2.innerText
        End If
      Next
    End If
  End If
  If x = 4 Then Exit For
Next
'' Поместить результат запроса на лист
ThisWorkbook.Sheets(1).Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)) = arr

Set objHTMLDoc = Nothing
Set objXML = Nothing
End Sub