Data Coronavirus desde Excel VBA

Hola mi querida comunidad hoy descargaremos Data Coronavirus desde Excel VBA actualizable con un simple click

Si bien podemos encontrar mucha información sobre esta pandemia, e incluso reportes, la gran mayoría está hecha con Power BI, y una de las grandes desventajas de esta herramienta es la actualización.

¿Por qué la actualización? Porque alguien debe actualizar la data para recién poderla ver reflejada en el reporte

Y VBA entre tantos, nos permite ser muy exquisitos, y he creado una macro, que se actualiza cada vez que lo necesitamos

Buenos sin más palabras, puedes descargar el archivo completamente gratis y con código libre, desde el siguiente enlace

Data Coronavirus desde Excel VBA.xlsm (Click en el enlace)

Dividiré la publicación en dos partes, en la primera explicaré el funcionamiento de esta macro, y en la segunda el código VBA

Funcionamiento del aplicativo de consulta coronavirus

Bien! Después de haber descargado el archivo (Lo puedes descargar desde este link), lo abriremos y encontraremos dos hojas

Data mundial del coronavirus
Data mundial del coronavirus
Data a nivel país del coronavirus
Data a nivel país del coronavirus

En la hoja «Global«, podrás visualizar data general del coronavirus a nivel mundial por país, en la hoja «Casos_por_país» podrás visualizar a más detalle información por país

Fuente de información de consulta

Y antes de continuar, seguro que viene la pregunta ¿De donde se alimenta esta macro? ¿Cuál es la fuente?

La fuente es muy confiable y se encuentra en el siguiente link worldometers.info/coronavirus/ es una de las mejores web con data exacta que he encontrado

Hay muchos reportes que han utilizado esta web ecdc.europa.eu, pero he encontrado demasiados errores en la data

Funcionamiento de la hoja Global

En la hoja Global, encontraremos un pequeño botón de nombre actualizar, al ejecutarlo, se realiza una consulta a la web y nos devuelve la información en la hoja

En la parte inferior de la hoja, barra de estado, podemos visualizar la cantidad de consultas que se están realizando

Consultando data covid 19
Consultando data de coronavirus desde Excel

Tenemos que esperar a que se complete la consulta, lo que lleva alrededor de 1 minuto, esto es porque se realiza un scrapeo desde VBA

Nos devuelve los siguientes campos:

  • Total de casos en el mundo
  • Total de muertes en el mundo
  • Total de recuperados en el mundo
  • Nombre del país
  • Casos Totales por país
  • Nuevos Casos por país
  • Total Muertes por país
  • Nuevas Muertes por país
  • Total Recuperados por país
  • Casos Activos por país
  • Críticos por país
  • Top Casos / 1Millón De P. por país
  • Muertes / 1 Millón P. por país
  • Total De Pruebas por país
  • Test / 1 Millón De P. por país
  • Continente por país
  • Detalle por país (Link)

Funcionamiento de la hoja Casos_por_país

En la siguiente hoja encontraremos diferentes opciones, con las que debemos trabajar son el desplegable y el botón

Seleccionamos un país (Por ejemplo Perú) y pulsamos el botón, la consulta demora alrededor de un minuto (Depende de la características de tu PC)

Data diaria coronavirus
Data diaria de coronavirus – Consulta

Nos muestra un mensaje de éxito, con la fecha y hora en la que se refrescó la data, este detalle es muy importante

La fecha y hora de actualización se toman considerando el GTM CERO, por ejemplo si me muestra que la data se actualizó el 13/04/2020 a las 06:00 horas, en Perú (5 horas menos) sería 13/04/2020 a la 01:00 hora

La conversión la podemos hacer mentalmente o podemos utilizar algún programa como 24timezones.com/es/difference/gmt/lima

No actualicé la hora al GTM de Perú (País en donde vivo) porque mi blog es consultado por diferentes países

Muy bien, hasta acá nos quedamos con el tema del funcionamiento, ahora en las siguientes líneas explicaré cómo se ha programado esta belleza

Programación del aplicativo Data Coronavirus desde Excel VBA

Va bueno, si estás leyendo esta parte es porque estás en cuarentena (Lo sé) jajaja, explicaré el código en dos partes, una para la hoja Global y otra para Casos_por_país

Programación en VBA – Casos mundiales de coronavirus

Bien, lo primero a realizar fue el diseño para ellos se utilizó:

  • Un botón Activex
  • 3 TextBox
  • 3 Labels
  • Una tabla simple
Maqueta de consulta coronavirus desde vba
Maqueta en blanco

Muy bien, la magia lo hace el botón Actualizar, sabemos que la consulta se debe realizar a la web worldometers.info/coronavirus/

Análisis de la web worldometers.info/coronavirus

Analicemos la web, para analizar cuál es mejor método a aplicar

Web worldometers

Genial, la data que necesitamos se encuentra en aquella tabla, que a simple vista parece un DataTable

Usaremos el inspector de elementos, para validar que se haya realizado con un DataTable

Datatable consulta coronavirus
Datatable consulta coronavirus

Validado, se han encontrado librerías y clases de DataTable, y después de realizar una mejor revisión del código JavaScript, concluyo lo siguiente

Se está utilizando como Backend a PHP, y en el desarrollo se utilizó un DataTable, el cual no realiza consultas cada vez que se aplica un filtro, sino en el index.php carga toda la data de la tabla, y la consulta la realiza con JavaScript a la información ya cargada

Ing. Luis Rojas

Entonces no podemos conectarnos directamente a un archivo PHP de consulta DataTable para obtener esta información, pero sí podemos conectarnos al index.php

Muy bien nuestra primera opción es conectarnos al index.php

Y una segunda opción podría ser conectarse a la web a través de Datos/Desde la web

Descargar información de web desde excel
Descargar información de web desde Excel

No es una mala idea, pero un dato que requerimos también es el href, el cual nos muestra a detalle la información por país

Href de información por país
Href de información por país

Debido a que el Href es necesario para la segunda hoja, nos quedamos con la primera opción

Realizando un scrapeo desde VBA

Muy bien, el proceso que aplicaremos será el siguiente:

  • Leer la información del Tbody de la tabla
  • Limpiar el código HTML
  • Delimitar las filas y columnas con algún caracter único
  • Con un Split convertir la data en un array
  • Recorrer el array e imprimir la data en Excel

Súper bueno, crearemos una función para los primeros tres puntos

Function ConsultaCoronavirus(ID As String) As String
    Dim respuesta$, web$, enviado$, Solicitud As Object
    Dim inicial&, final&, data$
    
    Select Case UCase(ID)
        Case "TOTAL"
            'Consulta a la web
                Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
                web = "https://www.worldometers.info/coronavirus/index.php"
                enviado = ""
                Solicitud.Open "POST", web, False
                Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
                Solicitud.send (enviado)
                respuesta = Solicitud.responseText
            'Consulta a la web
            
            'Información del tbody
                inicial = InStr(respuesta, "")
                final = InStr(respuesta, "")
                data = Mid(respuesta, inicial, final - inicial)
            'Información del tbody
            
            'Limpiar la data del tbody
                inicial = InStr(data, "country/us/")
                data = Mid(data, inicial, final - inicial)
                data = Replace(data, Chr(34), Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "  ", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty) '---
                data = Replace(data, "", Empty)
                data = Replace(data, "style:italic;", Empty)
                data = Replace(data, "font-", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "text-align:right class=sorting_1>", Empty)
                data = Replace(data, "text-align:right class=>", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "align:left;", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, Chr(13), " ")
                data = Replace(data, Chr(10), " ")
                data = Replace(data, "  ", " ")
            'Limpiar la data del tbody
            
            data = Replace(data, "", "--") 'Separación entre columnas
            data = Replace(data, "", "|") 'Para el salto de línea
            data = Replace(data, ">", "--") 'Para el Href
      End Select
ConsultaCoronavirus = data
End Function

Muy bien, con esta función ya podemos obtener la data de la web separada en filas por el caracter | y en columna por

Ahora programaremos el control ActiveX de actualización

Private Sub BTNactualizar_Click()
    Dim midata$, filas&, c, f, i&, j&
    'Borrar la información
        On Error Resume Next
        With wGlobal
            filas = .Range("A7").CurrentRegion.Rows.Count + 7
            .Range("A8", "A" & filas).EntireRow.Delete
        End With
        On Error GoTo 0
    'Borrar la información
    
    'Leer la data del scrapeo
        midata = ConsultaCoronavirus("TOTAL")
        c = Split(midata, "|")
        
        For i = LBound(c) To UBound(c) - 1
            f = Split(c(i), "--")
            Application.StatusBar = "Actualizando registro " & i & " de " & UBound(c) - 1
            For j = 1 To 13
                Cells(i + 8, j) = f(j)
            Next
            Cells(i + 8, 14) = Application.WorksheetFunction.Trim(f(0))
        Next
    'Leer la data del scrapeo
    
    'Actualizar las casillas de suma de totales
        TXTtotalcasos = Format(Application.WorksheetFunction.Sum(wGlobal.Range("B8", "B" & Rows.Count)), "#,##0")
        TXTtotalmuertes = Format(Application.WorksheetFunction.Sum(wGlobal.Range("D8", "D" & Rows.Count)), "#,##0")
        TXTtotalrecuperados = Format(Application.WorksheetFunction.Sum(wGlobal.Range("F8", "F" & Rows.Count)), "#,##0")
    'Actualizar las casillas de suma de totales
 
    MsgBox "Información actualizada correctamente", vbInformation
End Sub

Agregamos los Application y un manejo de errores

Private Sub BTNactualizar_Click()
    Dim midata$, filas&, c, f, i&, j&
    
    Application.StatusBar = "Consultando data..."
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    'Borrar la información
        On Error Resume Next
        With wGlobal
            filas = .Range("A7").CurrentRegion.Rows.Count + 7
            .Range("A8", "A" & filas).EntireRow.Delete
        End With
        On Error GoTo 0
    'Borrar la información
    
    'Leer la data del scrapeo
        On Error GoTo ErrorActualiza
        midata = ConsultaCoronavirus("TOTAL")
        c = Split(midata, "|")
        
        For i = LBound(c) To UBound(c) - 1
            f = Split(c(i), "--")
            Application.StatusBar = "Actualizando registro " & i & " de " & UBound(c) - 1
            For j = 1 To 13
                Cells(i + 8, j) = f(j)
            Next
            Cells(i + 8, 14) = Application.WorksheetFunction.Trim(f(0))
        Next
    'Leer la data del scrapeo
    
    'Actualizar las casillas de suma de totales
        TXTtotalcasos = Format(Application.WorksheetFunction.Sum(wGlobal.Range("B8", "B" & Rows.Count)), "#,##0")
        TXTtotalmuertes = Format(Application.WorksheetFunction.Sum(wGlobal.Range("D8", "D" & Rows.Count)), "#,##0")
        TXTtotalrecuperados = Format(Application.WorksheetFunction.Sum(wGlobal.Range("F8", "F" & Rows.Count)), "#,##0")
    'Actualizar las casillas de suma de totales
    
    Application.StatusBar = Empty
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Información actualizada correctamente", vbInformation
    Exit Sub
ErrorActualiza:
    Application.StatusBar = Empty
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Error, al actualizar la información", vbCritical
End Sub

Y hemos terminado con la primera hoja

Programación en VBA – Casos de coronavirus por país

Muy bien, en la última columna de la tabla en la hoja Global, colocamos el href, el cual nos ayudará a realizar el scrapeo por país

Me explico mejor, por ejemplo, el href para Perú es country/peru/, por lo que la web a consultar será https://www.worldometers.info/coronavirus concatenado a /country/peru/

Muy bien, empecemos con el diseño

Diseño básico consulta por país
Diseño básico consulta por país

Programando el Combobox de países

El combobox se debe actualizar con la data de la hoja Global, pero esta data podría cambiar (Si aumentan los países infectados)

Entonces crearemos un evento que se ejecute cuando se activa la hoja de Casos_por_pais

Private Sub Worksheet_Activate()
    Dim n%, i%
    If wCasos.CMBpais.ListCount = 0 Then
        
        Application.ScreenUpdating = False
        Application.Calculation = xlCalculationManual
        Application.DisplayAlerts = False
        wCasos.CMBpais.Clear
        With wGlobal
            n = .Range("A" & Rows.Count).End(xlUp).Row
            For i = 8 To n
                wCasos.CMBpais.AddItem .Range("A" & i)
            Next
        End With
        Application.ScreenUpdating = True
        Application.Calculation = xlCalculationAutomatic
        Application.DisplayAlerts = True
    End If
End Sub

Este código sólo se utilizará si el combo se encuentra sin data, para no saturar a la aplicación

Analizando la web de consulta

Casos de coronavirus Perú
Casos de coronavirus Perú
Casos de coronavirus gráficos
Gráficos de casos de coronavirus

Haciéndo un análisis de la web, nuestros amigos están utilizando a HighCharts para elaborar los gráficos

Data Coronavirus desde Excel VBA
Gráficos con HighCharts coronavirus

Si bien no tenemos la data en una tabla, la tenemos en el JavaScript, por lo que sí es posible realizar el scrapeo

Programando el scrapeo de la información por país

Muy bien, la data que vamos a obtener será

  • Total de casos acumulados de coronavirus por país
  • Casos diarios de coronavirus por país
  • Total de casos activos acumulados de coronavirus por país
  • Total de casos acumulados de fallecidos por país
  • Casos diarios de fallecidos por coronavirus por país

Y para ello adaptaremos a la función ConsultaCoronavirus creada para consulta en la hoja Global

Lo primero que vamos a programar, es la actualización de la fecha hora de actualización y de los tres label, el código sería el siguiente:

Public midata As String
Function ConsultaCoronavirus(ID As String, Optional LINK As String) As String
    Dim respuesta$, web$, enviado$, Solicitud As Object, fechas, valores
    Dim inicial&, final&, data$, datac$, i&
    
    Select Case UCase(ID)
        Case "TOTALGENERAL"
            Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
            
            web = "https://www.worldometers.info/coronavirus/" & LINK
            enviado = ""
            Solicitud.Open "POST", web, False
            Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
            Solicitud.send (enviado)
            respuesta = Solicitud.responseText
            midata = respuesta
            
            inicial = InStr(midata, "content-inner")
            final = InStrRev(midata, "Total Coronavirus Cases in")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            inicial = InStr(data, "Last updated:") + 14
            final = InStr(data, "") - 1
            data = Left(data, final)
            respuesta = "Data actualizada al: " & data & " 0 --"
            
            data = datac
            inicial = InStr(data, "maincounter-number")
            final = InStr(data, "panel_flip")
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            
            inicial = InStr(data, "#aaa") + 5
            final = InStr(data, "")
            respuesta = respuesta & "Total de casos: " & Mid(data, inicial, final - inicial) & "--"
            
            inicial = InStr(data, "Deaths") + 7
            data = Mid(data, inicial, Len(data))
            inicial = InStr(data, "") + 6
            final = InStr(data, "")
            respuesta = respuesta & "Total de fallecidos: " & Mid(data, inicial, final - inicial) & "--"
            
            inicial = InStr(data, "Recovered") + 9
            data = Mid(data, inicial, Len(data))
            inicial = InStr(data, "") + 6
            final = InStr(data, "")
            respuesta = respuesta & "Total de recuperados: " & Mid(data, inicial, final - inicial)
            
            data = respuesta
     End Select
     ConsultaCoronavirus = data
End Function


Debido a que se van a realizar varias consultas, veo apropiado guardar el primero scrapeo en la variable midata la cual es pública, de esa forma reduciremos el tiempo de ejecución

Para obtener que alimentará a nuestro Excel usaremos manejo de textos considerando como separador de fila a | y de columna a

Public midata As String
Function ConsultaCoronavirus(ID As String, Optional LINK As String) As String
    Dim respuesta$, web$, enviado$, Solicitud As Object, fechas, valores
    Dim inicial&, final&, data$, datac$, i&
    
    Select Case UCase(ID)
        Case "TOTAL"
            'Consulta a la web
                Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
                web = "https://www.worldometers.info/coronavirus/index.php"
                enviado = ""
                Solicitud.Open "POST", web, False
                Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
                Solicitud.send (enviado)
                respuesta = Solicitud.responseText
            'Consulta a la web
            
            'Información del tbody
                inicial = InStr(respuesta, "")
                final = InStr(respuesta, "")
                data = Mid(respuesta, inicial, final - inicial)
            'Información del tbody
            
            'Limpiar la data del tbody
                inicial = InStr(data, "country/us/")
                data = Mid(data, inicial, final - inicial)
                data = Replace(data, Chr(34), Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "  ", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty)
                data = Replace(data, "font-size:15px; text-align:left;>", Empty) '---
                data = Replace(data, "", Empty)
                data = Replace(data, "style:italic;", Empty)
                data = Replace(data, "font-", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "text-align:right class=sorting_1>", Empty)
                data = Replace(data, "text-align:right class=>", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, "align:left;", Empty)
                data = Replace(data, "", Empty)
                data = Replace(data, Chr(13), " ")
                data = Replace(data, Chr(10), " ")
                data = Replace(data, "  ", " ")
            'Limpiar la data del tbody
            
            data = Replace(data, "", "--") 'Separación entre columnas
            data = Replace(data, "", "|") 'Para el salto de línea
            data = Replace(data, ">", "--") 'Para el Href
            
        Case "TOTALGENERAL"
            Set Solicitud = CreateObject("winhttp.winhttprequest.5.1")
            
            web = "https://www.worldometers.info/coronavirus/" & LINK
            enviado = ""
            Solicitud.Open "POST", web, False
            Solicitud.setrequestheader "Content-type", "application/x-www-form-urlencoded"
            Solicitud.send (enviado)
            respuesta = Solicitud.responseText
            midata = respuesta
            
            inicial = InStr(midata, "content-inner")
            final = InStrRev(midata, "Total Coronavirus Cases in")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            inicial = InStr(data, "Last updated:") + 14
            final = InStr(data, "") - 1
            data = Left(data, final)
            respuesta = "Data actualizada al: " & data & " 0 --"
            
            data = datac
            inicial = InStr(data, "maincounter-number")
            final = InStr(data, "panel_flip")
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            
            inicial = InStr(data, "#aaa") + 5
            final = InStr(data, "")
            respuesta = respuesta & "Total de casos: " & Mid(data, inicial, final - inicial) & "--"
            
            inicial = InStr(data, "Deaths") + 7
            data = Mid(data, inicial, Len(data))
            inicial = InStr(data, "") + 6
            final = InStr(data, "")
            respuesta = respuesta & "Total de fallecidos: " & Mid(data, inicial, final - inicial) & "--"
            
            inicial = InStr(data, "Recovered") + 9
            data = Mid(data, inicial, Len(data))
            inicial = InStr(data, "") + 6
            final = InStr(data, "")
            respuesta = respuesta & "Total de recuperados: " & Mid(data, inicial, final - inicial)
            
            data = respuesta
        Case "HTOTALCASOS"
            inicial = InStrRev(midata, "coronavirus-cases-linear")
            final = InStrRev(midata, "coronavirus-cases-log")
             
            data = Mid(midata, inicial, final - inicial)
            datac = data
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "categories") + 13
            final = InStr(data, "yAxis") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            fechas = Split(data, ",")
            
            data = datac
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "data") + 7
            final = InStr(data, "responsive") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            valores = Split(data, ",")
            
            data = Empty
            For i = LBound(fechas) To UBound(fechas)
                data = data & fechas(i) & "--" & valores(i) & "|"
            Next
        Case "HTOTALCASOSDIARIO"
            inicial = InStrRev(midata, "graph-cases-daily")
            final = InStrRev(midata, "graph-active-cases-total")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "categories") + 13
            final = InStr(data, "yAxis") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            fechas = Split(data, ",")
            
            data = datac
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "data") + 7
            final = InStr(data, "responsive") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            valores = Split(data, ",")
            
            data = Empty
            For i = LBound(fechas) To UBound(fechas)
                If valores(i) = "null" Then
                    data = data & fechas(i) & "--" & 0 & "|"
                Else
                    data = data & fechas(i) & "--" & valores(i) & "|"
                End If
            Next
            
        Case "HTOTALCASOSACTIVO"
            inicial = InStrRev(midata, "graph-active-cases-total")
            final = InStrRev(midata, "coronavirus-deaths-linear")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "categories") + 13
            final = InStr(data, "yAxis") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            fechas = Split(data, ",")
            
            data = datac
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "data") + 7
            final = InStr(data, "responsive") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            data = Replace(data, "}", Empty)
            data = Replace(data, "  ", " ")
            valores = Split(data, ",")
            
            data = Empty
            For i = LBound(fechas) To UBound(fechas)
                If valores(i) = "null" Then
                    data = data & fechas(i) & "--" & 0 & "|"
                Else
                    data = data & fechas(i) & "--" & valores(i) & "|"
                End If
            Next
            
        Case "HTOTALCASOSMUERTE"
            inicial = InStrRev(midata, "coronavirus-deaths-linear")
            final = InStrRev(midata, "graph-deaths-daily")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "categories") + 13
            final = InStr(data, "yAxis") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            fechas = Split(data, ",")
            
            data = datac
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "data") + 7
            final = InStr(data, "responsive") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            data = Replace(data, "}", Empty)
            data = Replace(data, "  ", " ")
            valores = Split(data, ",")
            
            data = Empty
            For i = LBound(fechas) To UBound(fechas)
                If valores(i) = "null" Then
                    data = data & fechas(i) & "--" & 0 & "|"
                Else
                    data = data & fechas(i) & "--" & valores(i) & "|"
                End If
            Next
            
        Case "HTOTALCASOSMUERTEDIARIO"
            inicial = InStrRev(midata, "graph-deaths-daily")
            final = InStrRev(midata, "Latest Updates")
            data = Mid(midata, inicial, final - inicial)
            datac = data
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "categories") + 13
            final = InStr(data, "yAxis") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            fechas = Split(data, ",")
            
            data = datac
            data = Replace(data, Chr(13), Empty)
            data = Replace(data, Chr(10), Empty)
            data = Replace(data, Chr(34), Empty)
            data = Replace(data, "  ", " ")
            data = Replace(data, "  ", " ")
            inicial = InStr(data, "data") + 7
            final = InStr(data, "responsive") - 6
            data = Mid(data, inicial, final - inicial)
            data = Replace(data, "]", Empty)
            data = Replace(data, "}", Empty)
            data = Replace(data, "  ", " ")
            valores = Split(data, ",")
            
            data = Empty
            For i = LBound(fechas) To UBound(fechas)
                If valores(i) = "null" Then
                    data = data & fechas(i) & "--" & 0 & "|"
                Else
                    data = data & fechas(i) & "--" & valores(i) & "|"
                End If
            Next
        
    End Select
    
    ConsultaCoronavirus = data
End Function

Estamos usando bastante las funciones de texto des VBA, puedes leer a más detalle el uso de éstas en el siguiente enlace https://tutorialesexcel.com/descargas/funciones-de-texto-en-vba/

Muy bien, ahora tenemos que leer la información e imprimirlo en la hoja, usaremos el siguiente código

Private Sub BTNconsultar_Click()
    Dim respuesta$, f, c, i&, fila&, tabla As ListObject, tablas As Worksheet
    On Error Resume Next
    Application.StatusBar = "Consultando data..."
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
    'Consultar datos generales
        respuesta = ConsultaCoronavirus("TOTALGENERAL", wGlobal.Range("N" & Application.WorksheetFunction.Match(CMBpais, wGlobal.Range("A:A"), 0)))
        f = Split(respuesta, "--")
        Range("H5") = f(0)
        LBLtotal.Caption = f(1)
        LBLfallecidos.Caption = f(2)
        LBLrecuperados.Caption = f(3)
    'Limpiar data de las tablas
        For Each tabla In wCasos.ListObjects
            For i = 1 To tabla.ListRows.Count
                tabla.ListRows(1).Delete
            Next
        Next
    'Limpiar data de las tablas
    
    'Total de casos coronavirus
        respuesta = ConsultaCoronavirus("HTOTALCASOS")
    
        f = Split(respuesta, "|")
        fila = 28
        For i = UBound(f) - 1 To LBound(f) Step -1
            c = Split(f(i), "--")
            Range("B" & fila) = c(0)
            Range("C" & fila) = Val(c(1))
            fila = fila + 1
        Next
    'Total de casos coronavirus
    
    'Total de casos coronavirus diario
        respuesta = ConsultaCoronavirus("HTOTALCASOSDIARIO")
        f = Split(respuesta, "|")
        fila = 28
        For i = UBound(f) - 1 To LBound(f) Step -1
            c = Split(f(i), "--")
            Range("L" & fila) = c(0)
            Range("M" & fila) = Val(c(1))
            fila = fila + 1
        Next
    'Total de casos coronavirus diario
    
    'Total de casos activos
        respuesta = ConsultaCoronavirus("HTOTALCASOSACTIVO")
        f = Split(respuesta, "|")
        fila = 28
        For i = UBound(f) - 1 To LBound(f) Step -1
            c = Split(f(i), "--")
            Range("U" & fila) = c(0)
            Range("V" & fila) = Val(c(1))
            fila = fila + 1
        Next
    'Total de casos activos
    
    'Total de muertes
        respuesta = ConsultaCoronavirus("HTOTALCASOSMUERTE")
        f = Split(respuesta, "|")
        fila = 28
        For i = UBound(f) - 1 To LBound(f) Step -1
            c = Split(f(i), "--")
            Range("AE" & fila) = c(0)
            Range("AF" & fila) = Val(c(1))
            fila = fila + 1
        Next
    'Total de muertes
    
    'Total de muertes por día
        respuesta = ConsultaCoronavirus("HTOTALCASOSMUERTEDIARIO")
        f = Split(respuesta, "|")
        fila = 28
        For i = UBound(f) - 1 To LBound(f) Step -1
            c = Split(f(i), "--")
            Range("AP" & fila) = c(0)
            Range("AQ" & fila) = Val(c(1))
            fila = fila + 1
        Next
    'Total de muertes por día
    
    Application.StatusBar = Empty
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.Calculation = xlCalculationAutomatic
    MsgBox "Proceso completado" & Chr(13) & Range("H5"), vbInformation
End Sub

La data la imprimiremos desde la fila 28, ya que he agregado unos gráficos simples y un segmentador de datos, quedando de la siguiente forma

Muy bien hemos terminado

Recuerda que si quieres aprender a programar desde cero, puedes llevar mi curso online de programación en Excel VBA desde cero

Ing. Luis Rojas

Descargar Data Coronavirus desde Excel VBA.xlsm

Sígueme en Facebook desde facebook.com/tutorialesexcelvba y en Youtube desde youtube.com/ingluisrojas

Esta entrada tiene 3 comentarios

  1. Francisco Pantoja

    Hola lo encontré genial, muy exacto, pero como podría modificar la función para poder saber en tiempo real, la estadistica por «el tipo de muertes en el mundo», es decir, saber la cantidad de , por ejemplo: Muertes por aborto, por alcohol, etc.

  2. javier delgado

    los descargue hace unas semanas y muy buen aporte pero desde 20 de mayo hay un desface en la información javier México

  3. Karina Osorio

    Hola! Lo encontré casualmente en Facebook… Me parece excelente… Muy útil… Muchísimas gracias

Deja una respuesta