Statistiche Coronavirus

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Ciao a tutti,
allego due file che estraggono i dati relativi alla diffusione e agli effetti del coronavirus nello scenario mondiale e italiano.

CORONAVIRUS MONDO
Visual Basic:
Sub Coronavirus_Scraping()
    Dim IE As Object
    Dim Doc As Object
    Dim HTMLTab As Object
    Dim HTMLrow As Object
    Dim iRow As Long
    Dim iCol As Integer
    Dim HTMLcel As Object
   Range("A2:H1000").ClearContents
    Const myURL As String = "https://www.worldometers.info/coronavirus/"
    Set IE = CreateObject("InternetExplorer.Application")
    With IE
        .navigate myURL
        .Visible = False
        Do While .Busy: DoEvents: Loop
        Do While .readyState <> 4: DoEvents: Loop
    End With
    Set Doc = IE.document
    On Error GoTo qui
    Set HTMLTab = Doc.getElementsByTagName("table")(0)
    For Each HTMLrow In HTMLTab.Rows
        iRow = iRow + 1
        iCol = 0
        For Each HTMLcel In HTMLrow.Cells
            iCol = iCol + 1
            Cells(iRow, iCol) = HTMLcel.innerText     
        Next HTMLcel
    Next HTMLrow
    Cells(1, "M") = "Aggiornamento del " & Now
    Cells(1, "M").Select
qui:
    IE.Quit
    Set IE = Nothing
    Set Doc = Nothing
End Sub
CORONAVIRUS ITALIA
Visual Basic:
Sub estrai_web()
    Dim indirizzo As New MSXML2.XMLHTTP60
    Dim Doc As New MSHTML.HTMLDocument
    Dim VidCats As MSHTML.IHTMLElementCollection
    Dim VidCat As MSHTML.IHTMLElement
    indirizzo.Open "GET", "http://www.salute.gov.it/portale/nuovocoronavirus/dettaglioContenutiNuovoCoronavirus.jsp?lingua=italiano&id=5351&area=nuovoCoronavirus&menu=vuoto", False
    Cells(1, 100) = 0
    On Error GoTo esci
    indirizzo.send
    If indirizzo.Status <> 200 Then
        MsgBox "Problemi"
        Exit Sub
    End If
    Sheets("Foglio1").Range("A1:A1000") = ""
    Doc.body.innerHTML = indirizzo.responseText
    Set VidCats = Doc.getElementsByTagName("li")
    For Each VidCat In VidCats
        x = x + 1
        If x >= 24 Then
            y = y + 1
            Sheets("Foglio1").Cells(y, 1) = VidCat.innerText
        End If
    Next
    Exit Sub
esci:
    Cells(1, 100) = 1
    MsgBox "Si è verificato un errore inatteso!", vbExclamation, "ATTENZIONE"
End Sub
 

Allegati

Bruno

Utente assiduo
Expert
13 Settembre 2015
1.287
115
Italy
365/64 Bit W10
146
Ciao

Oggi è comparso un avviso con il file Coronavirus Italia.xlsm

MsgBox "Si è verificato un errore inatteso", vbCriticalm, "NOTIFICA!"
 

Powerwin

VBA Expert
Expert
17 Marzo 2016
4.704
115
vicino a Milano
2019
107
Ciao ges @ges c'è un piccolo errore nel codice per i dati Italia, nel modulo al posto di:
Visual Basic:
For j = 2 To Cells(Rows.Count, 5).End(xlUp).Row
va inserito
Visual Basic:
For j = 2 To Cells(Rows.Count, 11).End(xlUp).Row
Visual Basic:
altrimenti non inserisce le percentuali delle ultime 3 regioni
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Ciao Powerwin @Powerwin , hai ragione, è stata una svista, correggo subito (Ho sostituito il file sopra)
Con l'occasione metto anche un On Error Resume Next in testa al codice così evito di gestire tutti i possibili errori (un utente che gli è uscita la finistra con l'IDE del vba mi ha scritto "e adesso che faccio?" in realtà quando lo aveva avviato non aveva la connessione a internet e dopo un po' gli è uscito l'errore)
 

Marius44

VBA Expert
Moderatore
Expert
9 Settembre 2015
6.232
115
76
Catania
Excel2010
197
Ciao Ges
Mi sembra che ci sia qualche "sbavatura" nel riporto dei dati.
Italia - Contagiati e Casi attivi riporta lo stesso numero
Mondo - Contagiati e Morti porta lo stesso numero. E' corretto il numero dei Guariti?

Ciao,
Mario
 

Marius44

VBA Expert
Moderatore
Expert
9 Settembre 2015
6.232
115
76
Catania
Excel2010
197
Ciao Ges
Scusa se continuo ad importunarti ma ancora stamattina i dati complessivi (ultima versione del file) di Europa e Mondo continuano ad essere errati.
Ciao,
Mario
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Ciao Marius44 @Marius44 non ho toccato i criteri di Europa e Mondo però a me sembra che vadano bene. Che problema trovi?
 

Marius44

VBA Expert
Moderatore
Expert
9 Settembre 2015
6.232
115
76
Catania
Excel2010
197
Ciao ges @ges
In Mondo vedo Contagiati 4027, Morti 4027, Guariti 64099
In Europa vedo Contagiati 538, Morti 822, Guariti 822

Aggiornato stamattina.
Ciao,
Mario


PS - Ho riaggiornato adesso ed è tutto OK. Misteri di IE Lingua_lingua
 
  • Like
Reactions: MastroLindo

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Prova a rilanciarlo, io li vedo corretti.
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Ottima iniziativa klingklang @klingklang solo adesso non ho PowerBy Desktop le leggere il file .pbix
 

ges

Excel/VBA Expert
Amministratore
Expert
21 Giugno 2015
25.144
1.865
Como
2011MAC 2016WIN
586
Ciao,
grazie questo sito è quello che ho utilizzato nel codice del primo messaggio.
 

guidoald

Utente junior
25 Giugno 2015
29
1
61
Firenze
2013
0
Ciao, mi accodo all'idea di ges @ges proponendo una versione (abbastanza rozza) in Power BI, se qualcuno vuole provarlo e darci un'occhiata Saluto_saluto

Ciao. lo guarderei volentierissimo ma mi da un errore al caricamento
required property connection not founf in json. Path ",line 1, position 136

E' il mio powerbi desktop?
 

Marius44

VBA Expert
Moderatore
Expert
9 Settembre 2015
6.232
115
76
Catania
Excel2010
197
Ciao a tutti

1° Quanto allegato da klingklang @klingklang non riesco a vederlo. Mi dà lo stesso errore di cui sopra.
2° Il file di ges @ges molto (ma mooooolto spesso) dà risultati errati, specie nell'indicazione dei totali a sinistra dei fogli. Probabilmente è stata cambiata qualcosa nel sito.

Una buona giornata "da reclusi" a tutti Lingua_linguacappello_salutaLingua_linguacappello_saluta
Mario
 

Sostieni ForumExcel

Aiutaci a sostenere le spese e a mantenere online la community attraverso una libera donazione!