Come Estrarre Dati Relativi Ad Una Pagina Meteo con questo mio link

[oregon]

Leggi bene la mia risposta e fornisci chiarimenti sul codice che hai usato, commenta le righe e cosa fanno e dicci che errori hai (codici e messaggi durante l'esecuzione), dacci un tuo parere, ragioniamo insieme, non chiedere solo una soluzione.

Vale in questo e in tutti gli altri forum... (non cambia nulla se cambia Papa...).

Buona Pasqua

[A.Maurizio]

La mia richiesta e sempre la stessa ; Fatta ieri.
E cio� : Come puoi vedere dal mio listato, ho inserito il termine (row) perch� questo sito usa una forma Tabellare da quanto ho capito io.
Pertanto se metto in entrambi le posizioni il termine (row) esso mi prende tranquillamente la prima parte dei dati che sono: (" Data - localit� - Perturbazione in percentuale ecc...! ")
Mentre il termine (table e div ) dovrebbe prendere tutto il resto come si vede nell'immagine che ho inserito ieri nel mio primo post.

Ora il problema e questo: Se uso come ho gi� detto e fatto in precedenza il termine (row) la prima parte viene estratta
Al contrario non so come estrarre i dati inerente alle Mn o Max anche solo della prima fila di dati Proprio come si vede nell'immagine
Tutto qui .
E pensare che in un altro progetto fatto in un altro foglio di excel , riesco ad estrarre qui tutto quanto
Purtroppo per� in questo caso ; L'estrazione di tutti i dati avvengono tutti in una sola cella.
Pertanto sono punto e a capo.
E non s� come risolvere questo problema.
Per� se magari tu che sei decisamente pi� capace di me
Prova a dare un occhiata a questo listato ; Che � poi quello che ti ho appena descritto
Solo che ripeto il tutto avviene solo nella cella (B13)

Sempre ch� non commetta qualche cosa che non va
Questo e il Listato N.2 :

Option Explicit

Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, _
ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long


Dim Campo As Range
Dim IE
Dim Forma As Object
Dim myStart
Dim Y As String, X As String
Dim Getimgurl As HeaderFooter


Dim rngTarget As Range
Dim getElementsByTagName As Variant
Dim getElementsByClassName As Variant
Dim innerText As Variant


Dim OggCol As Object, OggCol1 As Object, OggCol2 As Object, OggCol3 As Object, OggCol4 As Object, OggCol5 As Object, OggCol6 As Object, OggCol7 As Object, OggCol8 As Object, OggCol9 As Object, OggCol10 As Object
Dim cell, shp As Shape, Target As Range
Dim rng As Object
Dim filenam As Variant
Dim I As Long


Dim cel As Variant, Text As Variant, Riga As Variant, UltimaRiga As Variant, Search As Variant, SearchRange As Variant, MyStr As Variant, MyStr2 As Variant, UpperCase As Variant, UpperCase2 As Variant


Dim Domanda As String, Domanda2 As String


Sub Previsioni_Meteo(ByVal myURL As String)
On Error GoTo finish


X = Foglio1.Range("D1").Value & ""


'Va Chiamata passandogli l'URL da leggere
myURL = "https://www.3bmeteo.com/meteo/" & X & ""


Set IE = CreateObject("InternetExplorer.Application")
   
With IE
.Navigate myURL
.Visible = True


Do While .Busy: DoEvents: Loop
Do While .ReadyState <> 4: DoEvents: Loop


End With


Do
    DoEvents
    If Timer > myStart + 2 Or Timer < myStart Then Exit Do
Loop


'Scrive sul Foglio Attivo
On Error Resume Next


Set OggCol = IE.Document.getElementsByClassName("row") '- Localit� Me1teo
Set OggCol1 = IE.Document.getElementsByClassName("table") '(0).innerText         '- Minima Attuale


Set OggCol2 = IE.Document.getElementsByClassName("table")
'Set OggCol4 = OggCol1(1).getElementsByTagName("glider-track")(0).innerText


With IE.element.getAttribute("table")
Sheets("Meteo").Range("B14").Value .getAttribute("=col-xs-1.2")(0).innerText
'Sheets("Meteo").Range("B11").Value = ("=col-xs-1-3 col-sm-3-5") & innerText


Sheets("Meteo").Cells(8, 2) = OggCol(0).innerText


Sheets("Meteo").Cells(13, 2) = OggCol2(0).innerText


End With






'Sheets("Meteo").Cells(13, 0) = OggCol(0).innerText
'���������������������������������������������������������������������������������
'For I = 1 To OggCol1.Length


'With Foglio1


'.Range("B30").Offset(I, 0) = OggCol3(I).getAttribute("src")




'End With


'Next I


'################################################################################
'X = Mid(Foglio1.Range("B13").Value, 70)


'Foglio1.Range("B9").Value = "" & X






'################################################################################
'Range("A11").VerticalAlignment = xlCenter


'Foglio1.Range("A:B").WrapText = True


'Foglio1.Range("A1").Select


'################################################################################
'Chiusura IE
'IE.Quit
Set IE = Nothing


Call Preleva_I_Dati_Dalla_Cella_web
'Call dividi
finish:
End Sub


Sub Preleva_I_Dati_Dalla_Cella_web()
'Contatore per la scrittura di parole trovate
Riga = 2


'Svuota l'ultima ricerca
UltimaRiga = ThisWorkbook.Worksheets("Meteo").Range("L1").End(xlDown).Row
If ThisWorkbook.Worksheets("Meteo").Range("L2") <> "" Then
    ThisWorkbook.Worksheets("Meteo").Range("L2:L" & UltimaRiga).ClearContents
End If


Set Search = ThisWorkbook.Worksheets("Meteo").Range("K2:K100")
Set SearchRange = ThisWorkbook.Worksheets("Meteo").Range("B13")
 
For Each cel In SearchRange
    For Each Text In Search
        If InStr(cel, Text) Then
            Debug.Print "Trovato " & Text & " alla cella " & cel.Address


            'Scrivere le parole trovate
            ThisWorkbook.Worksheets("Meteo").Range("L" & Riga).Value = Text
            Riga = Riga + 1
        End If
    Next Text
Next cel


Call Rendi_La_Prima_Letta_In_Maiuscolo
End Sub


Sub Rendi_La_Prima_Letta_In_Maiuscolo()
'Domanda = InputBox("Inserire il Tuo Nome Grazie...!")
Domanda = Foglio1.Range("L2").Value
Domanda2 = Foglio1.Range("L3").Value


  MyStr = Domanda
   MyStr2 = Domanda2


UpperCase = Left(Domanda, 1)
UpperCase2 = Left(Domanda2, 1)
  'Foglio1.Range("A3").Value = "Ciao"
    Foglio1.Range("L2").Value = UCase(UpperCase) + Mid(Domanda, 2, 15)
Foglio1.Range("L3").Value = UCase(UpperCase2) + Mid(Domanda2, 2, 15)


Call Preleva_Solo_I_Dati_Interessati
End Sub


Sub Preleva_Solo_I_Dati_Interessati()


'Foglio1.Range("A6:C6").WrapText = True


With Foglio1
.Range("L2").Copy
.Range("B9").PasteSpecial


.Range("L3").Copy
.Range("B10").PasteSpecial


End With


'Foglio1.Range("B13").Select
'Foglio1.Range("B13").Clear


'Call Converti_In_Maiuscol_a_Prima_Lettera


End Sub


Sub Converti_In_Maiuscol_a_Prima_Lettera()
Dim Stringa, Parola
Dim Righe, R, Colonne
Dim Intervallo As Range
' prima fase: determino li'intervallo su cui lavorare
With Range("L2").Value
Righe = .Rows.Count
Colonne = .Columns.Count
Set Intervallo = .Resize(Righe, Colonne)
End With
If IsEmpty(Intervallo) Then
MsgBox "L'intervallo � vuoto"
Exit Sub
End If
' seconda fase: conversione delle stringhe mettendo in maiuscolo i soli primo caratteri
For R = 1 To Righe
Stringa = Intervallo(R, 1)
If Stringa <> "" Then
Parola = StrConv(Stringa, vbProperCase)
Intervallo(R, 1) = Parola
End If
Next


'Call Rimuovi_Il_Ritorno_A_Capo_Delle_Celle
End Sub






Sub Rimuovi_Il_Ritorno_A_Capo_Delle_Celle()
     Dim Intervallo As Range
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual


     For Each Intervallo In ActiveSheet.UsedRange
        If 0 < InStr(Intervallo, Chr(10)) Then
            Intervallo = Replace(Intervallo, Chr(10), "")
        End If
     Next






     Application.ScreenUpdating = True
     Application.Calculation = xlCalculationAutomatic
     


End Sub