Saltar al contenido
PROGRAMAR EN VBA MACROS DE EXCEL

ESTADISTICAS Mundiales del CORONAVIRUS – Web Scraping – Raspado Web – 1007 Parte 2

Estadisticas actualizadas coronavirus covid 19

Estadísticas Actualizadas Coronavirus – Parte 2

Continuando con la explicación, que esta dividida en tres partes, sobre como se puede crear un Libro de Excel que muestra las estadísticas mundiales actualizadas de Coronnavirus – Covid 19, en este post se explica específicamente como se hace un WEB SCRAPING o RASPADO WEB con Excel VBA, obteniendo los datos actualizados de los casos de CORONAVIRUS o COVID-19 país por país.

Los links a las otras partes del ejemplo macro de Excel para realizar web scraping se muestra a continuación:

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007/parte1

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007-parte2

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-1007-parte3/

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-modificar-ribbon-1008-parte4//

https://macrosenexcel.com/estadisticas-mundiales-del-coronavirus-web-scraping-raspado-web-insertar-graficos-1009-parte5

Opera Excel como los mejores haz click acá, si quieres aprender sobre Excel en inglés, entonces debes hacer click here. Si lo que necesitas es aprender o profundizar sobre la programación de macros con VBA este es unos de los mejores cursos on line que he visto en internet, te lo recomiendo no te arrepentirás.

Suscribe a nuestro canal de You Tube, mira el playlist con  vídeos relacionados donde podrás ver la macro en acción con una explicación en forma visual que ayudará a entender el ejemplo en forma más fácil.

Estadísticas Actualizadas sobre Coronavirus en Excel – Web Scraping

Ya se explicó los distintos menús que contiene el Libro de Excel con las Estadísticas Mundiales Actualizadas de Coronavirus – Covid 19, en este post explicaremos específicamente como se realiza el raspado WEB a una web de estadísticas mundiales de mucho prestigio, la misma se denomina https://www.worldometers.info/coronavirus/

Recordemos que para realizar el scraping web o raspados web con Excel VBA, con este método no se necesita el navegador Explorer ni Chrome, se realiza mediante XMLHTTP, en los próximos ejemplos se mostrará como hacer lo mismo con Explorer y con el navegador Google Chrome, suscriban ingresando mail desde la derecha de la página para que se les envíe a su casilla de correo.


Quizás también interese leer:

Como Deshabilitar el Menu Contextual Segundo Boton Mouse en Excel
Como Deshabilitar Combinación Teclas para Copiar Cortar y Pegar en Excel
Como Evitar Robo Informacion Deshabilitar Copiar Cortar y Pegar Imprimir Guardar Como en Excel

Extrayendo una Tabla con Datos País por País de los Casos de Covid 19 Actualizados con Macro de Excel para Scraping Web o Raspado Web

Desde la pestaña actualizar, icono verde con mapa del mundo, que es el primer icono de la pestaña personalizada «ESTADISTICAS CORONAVIRUS COVID 19», se pueden obtener los datos de la web (Scrapin Web) https://www.worldometers.info/coronavirus/ y guardarlos en Excel, al presionarlo se verá una Barra de Progreso que muestra el progreso de la extracción de datos, que se realiza en forma rápida en unos pocos segundos y se muestran los datos en la Hoja de Excel país por país los casos de Coronavirus y la fecha y hora de actualización de los datos, a lo que se le adiciona un gráfico de mapa mundial de Excel

Los datos productos del raspado web con Excel VBA se muestran en forma ordenada y con formato para una mejor presentación visual de los datos, desde luego ustedes pueden modificar adaptando el código y darle el formato que se les ocurra.

Explicación del Código de la Macro para Scraping Web o Raspado Web del Libro de Excel con Estadísticas Mundiales Actualizadas de Coronavirus 

En primer lugar lo que se hará es crear una hoja auxiliar temporal para poder escribir en ella los datos extraídos, en este caso la tabla con datos de estadísticas país por país de los casos de coronavirus – covid 19, ello se hace con el siguiente código, que primero borra la hoja «Actualizar» en caso de existir, luego agrega una hoja y le da el nombre «Actualizar», de las siguiente forma:

For Each she In Worksheets
mys = she.Name
If she.Name = «Actualizar» Then she.Delete
Next
ActiveWorkbook.Sheets.Add AFTER:=Worksheets(Worksheets.Count)
ActiveSheet.Name = «Actualizar»

Luego se procede a crear un objeto XMLHTTP enviando una petición la URL de la web que queremos hacer el scraping web o raspado web, luego la respuesta de esa petición, guardada en la variable MyRespu convirtiendo los datos obtenidos a Unicode,  se debe tener en cuenta que en la variable MyRespu se encuentra contenido todo el código Html de la página a la cual hicimos el raspados web con la macro de Excel, se hace de la siguiente forma:

With CreateObject(«MSXML2.XMLHTTP»)
.Open «GET», «https://www.worldometers.info/coronavirus/», False
.send
ActiveWindow.Application.SendKeys «(~)»
MyRespu = StrConv(.responseBody, vbUnicode)
End With

MyRespu = Mid$(MyRespu, InStr(1, MyRespu, «<!DOCTYPE «))

With CreateObject(«htmlFile»)
.Write MyRespu

Set MyTable = .getElementsByTagName(«table»)(0)
End With

Se hace un objeto con el elemento tabla de la página web y que está contenido en el código Html de la web que se encuentra en la variable «MyRespu», luego se llama a la función que busca el elemento tr y td en el código de la página WEB contenido en este momento en la variable «MyRespu», se usa para ello el siguiente código para llamar a la función:

Sheets(«Actualizar»).Select
WriteTable MyTable


Ahora bien, la función para armar la tabla nuevamente, leyendo el código html contenido en la variable «MyRespu», irá leyendo el Html y escribirá la tabla, extraída con Web Scraping Excel VBA, en la hoja «Actualizar», como resultado obtendremos la tabla que se encontraba en la página de la Web mencionada, la función es la siguiente:

Public Sub WriteTable(ByVal MyTable As Object, Optional ByVal StarR As Long = 1, Optional ByVal Ws As Worksheet)
Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
Dim Titulos As Object, Titulo As Object, CantCol As Long

If Ws Is Nothing Then Set Ws = ActiveSheet
R = StarR
With ActiveSheet
Set Titulos = MyTable.getElementsByTagName(«th»)
For Each Titulo In Titulos
CantCol = CantCol + 1
.Cells(StarR, CantCol) = Titulo.innerText
Next Titulo
StarR = StarR + 1
Set tBody = MyTable.getElementsByTagName(«tbody»)
For Each tSection In tBody ‘HTMLTableSection
Set tRow = tSection.getElementsByTagName(«tr») ‘HTMLTableRow
For Each tr In tRow
R = R + 1
Set tCell = tr.getElementsByTagName(«td»)
C = 1
For Each td In tCell ‘DispHTMLElementCollection
.Cells(R, C).Value = td.innerText ‘HTMLTableCell
C = C + 1
Next td
Next tr
Next tSection
End With 

Hasta aquí esta segunda parte, de este ejemplo denominado Estadísticas Mundiales de Coronavirus – Scraping Web o Raspado Web, en la próxima entrega (Parte 3) veremos como extraer datos puntuales de la misma web, formato y guardado en Access de los datos obtenidos, suscribe a nuestra web para que enviemos un mail para avisarte de nuevo contenido.

Descarga del Libro Excel con código del ejemplo Como Hacer Scraping Web o Raspado Web

Desde el final puedes descargar el Libro de Excel de ejemplo que se usa en el vídeo relacionado que recomiendo ver para su mejor y más fácil entendimiento.

Recuerda se debe bajar el archivo comprimido y guardar o descomprimir los tres archivos contenidos en un mismo directorio, no importa donde, solo que estén juntos en un mismo directorio, el archivo .rar contiene: el libro de Excel con la macro, el archivo con la base de datos de Access y un archivo PDF que es la ayuda o manual de usuario que muestra como operar el aplicativo para extraer datos de la web, web scraping o raspado web obteniendo Estadisticas Mundiales Actualizadas del Coronavirus o Covid 19.

Se descarga en forma gratuita sin ninguna restricción, el código se puede adaptar a cada necesidad, aporta a sostener la esta web si está dentro de tus posibilidades, desde ya muchas gracias.

Código que va en el módulo Actualizar

Sub ObtieneEstadistica()
Dim MyRespu As String, MyTable As Object
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next

‘Elimina, crea hoja, asigna nombre
For Each she In Worksheets
mys = she.Name
If she.Name = «Actualizar» Then she.Delete
Next
ActiveWorkbook.Sheets.Add AFTER:=Worksheets(Worksheets.Count)
ActiveSheet.Name = «Actualizar»

UserForm1.ProgressBar1.Value = 20
UserForm1.Label1.Caption = «20 %»
DoEvents

Set a = Sheets(«Actualizar»)
a.Cells.Delete
Set b = Sheets(«Estadisticas»)

UserForm1.ProgressBar1.Value = 30
UserForm1.Label1.Caption = «30 %»
DoEvents

Application.DisplayAlerts = False

With CreateObject(«MSXML2.XMLHTTP»)
.Open «GET», «https://www.worldometers.info/coronavirus/», False
.send
ActiveWindow.Application.SendKeys «(~)»
MyRespu = StrConv(.responseBody, vbUnicode)
End With

MyRespu = Mid$(MyRespu, InStr(1, MyRespu, «<!DOCTYPE «))

With CreateObject(«htmlFile»)
.Write MyRespu

Set MyTable = .getElementsByTagName(«table»)(0)
End With

UserForm1.ProgressBar1.Value = 40
UserForm1.Label1.Caption = «40 %»
DoEvents

Sheets(«Actualizar»).Select
WriteTable MyTable

UserForm1.ProgressBar1.Value = 50
UserForm1.Label1.Caption = «50 %»
DoEvents

‘Copia y ordena los datos en la hoja Estadistica
If b.FilterMode = True Then b.ShowAllData
ufb = b.Range(«A» & Rows.Count).End(xlUp).Row
If ufb <= 21 Then ufb = 22
b.Range(«A22:I» & ufb).Clear

b.Range(«F2:I2»).Merge
b.Range(«F2:I2»).HorizontalAlignment = xlCenter

b.Range(«A6») = «TOTAL CASOS CORONAVIRUS – COVID 19»
b.Range(«A7») = «TOTAL CASOS»
b.Range(«A8») = «TOTAL MUERTOS»
b.Range(«A9») = «TOTAL RECUPERADOS»

b.Range(«A11») = «TOTAL CASOS ACTIVOS»
b.Range(«A12») = «TOTAL INFECTADOS»
b.Range(«A13») = «TOTAL CONDICION LEVE»
b.Range(«A14») = «TOTAL CONDICION CRITICA»

b.Range(«A16») = «TOTAL CASOS CERRADOS»
b.Range(«A17») = «TOTAL CASOS TUVIERON RESULTADO»
b.Range(«A18») = «TOTAL RECUPERADOS»
b.Range(«A19») = «TOTAL MUERTOS»

UserForm1.ProgressBar1.Value = 60
UserForm1.Label1.Caption = «60 %»
DoEvents

a.ranga(«J1») = MyRespu

‘Ultima actualización
Principio = «>Last updated: «
Final = «<a href=»»/coronavirus/coronavirus-cases/»»> Case Graphs»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
Lastupdate = Replace(dato, Principio, «»)
Lastupdate = Replace(Lastupdate, Chr(34), «»)
Lastupdate = Replace(Lastupdate, «</div>», «»)
Lastupdate = Replace(Lastupdate, «<div style=margin-top:20px; text-align:center; font-size:14px>», «»)
Lastupdate = Replace(Lastupdate, Chr(10), «») ‘elimina tabulaciones

‘Total de Casos
Principio = «<span style=»»color:#aaa»»>»
Final = «<a href=»»#countries»»>view by country</a>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCasos = Replace((Replace(dato, Principio, «»)), «,», «»)
Posi3 = InStr(TotalCasos, » «)
TotalCasos = Left(TotalCasos, Posi3)
TotalCasos = Replace(TotalCasos, «,», «»)

‘Total de Muertos
Principio = «<h1>Deaths:</h1>»
Final = «<h1>Recovered:</h1>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalMuertos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalMuertos = Replace(TotalMuertos, Chr(34), «») ‘elimina comillas
TotalMuertos = Replace(TotalMuertos, «<div class=maincounter-number>», «»)
TotalMuertos = Replace(TotalMuertos, «<span>», «») ‘elimina texto
TotalMuertos = Replace(TotalMuertos, «</span>», «»)
Posi3 = InStr(TotalMuertos, «</div>»)
TotalMuertos = Left(TotalMuertos, Posi3 – 1)
TotalMuertos = Replace(TotalMuertos, Chr(32), «») ‘elimina espacio blanco
TotalMuertos = Replace(TotalMuertos, Chr(10), «») ‘elimina tabulaciones

‘Total de Recuperados
Principio = «<h1>Recovered:</h1>»
Final = «<div style=»»margin-top:50px;»»>»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalRecuperados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalRecuperados = Replace(TotalRecuperados, Chr(34), «») ‘elimina comillas
TotalRecuperados = Replace(TotalRecuperados, «<div class=maincounter-number style=color:#8ACA2B >», «»)
TotalRecuperados = Replace(TotalRecuperados, «<span>», «») ‘elimina texto
TotalRecuperados = Replace(TotalRecuperados, «</span>», «»)
Posi3 = InStr(TotalRecuperados, «</div>»)
TotalRecuperados = Left(TotalRecuperados, Posi3 – 1)
TotalRecuperados = Replace(TotalRecuperados, Chr(32), «») ‘elimina espacio blanco
TotalRecuperados = Replace(TotalRecuperados, Chr(10), «») ‘elimina tabulaciones

UserForm1.ProgressBar1.Value = 70
UserForm1.Label1.Caption = «70 %»
DoEvents


‘Total de Infectados
Principio = «<div class=»»panel-body»» style=»»text-align:center; height:200px;»»>»
Final = «<div style=»»font-size:13.5px»»>Currently Infected Patients»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalInfectados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalInfectados = Replace(TotalInfectados, Chr(34), «») ‘elimina comillas
TotalInfectados = Replace(TotalInfectados, «<div class=panel_flip>», «»)
TotalInfectados = Replace(TotalInfectados, «<div class=panel_front style=width:100%;height:100%;>», «»)
TotalInfectados = Replace(TotalInfectados, «<div class=number-table-main>», «»)
Posi3 = InStr(TotalInfectados, «</div>»)
TotalInfectados = Left(TotalInfectados, Posi3 – 1)
TotalInfectados = Replace(TotalInfectados, Chr(32), «») ‘elimina espacio blanco
TotalInfectados = Replace(TotalInfectados, Chr(10), «») ‘elimina tabulaciones

‘Total de Condicion Leve
Principio = «Currently Infected Patients</div>»
Final = «<div style=»»font-size:13px»»>in Mild Condition»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalLeves = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalLeves = Replace(TotalLeves, Chr(34), «») ‘elimina comillas
TotalLeves = Replace(TotalLeves, «<div style=padding-top:20px;position:relative;text-align:center; >», «»)
TotalLeves = Replace(TotalLeves, «<div style=float:left; text-align:center>», «»)
TotalLeves = Replace(TotalLeves, «<span class=number-table style=color:#8080FF>», «»)
Posi3 = InStr(TotalLeves, «</span>»)
TotalLeves = Left(TotalLeves, Posi3 – 1)
TotalLeves = Replace(TotalLeves, Chr(32), «») ‘elimina espacio blanco
TotalLeves = Replace(TotalLeves, Chr(10), «») ‘elimina tabulaciones

‘Total de Condición Critica
Principio = «in Mild Condition</div>»
Final = «<div style=»»font-size:13px»»>Serious or Critical»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCriticos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCriticos = Replace(TotalCriticos, Chr(34), «») ‘elimina comillas
TotalCriticos = Replace(TotalCriticos, «<br>», «»)
TotalCriticos = Replace(TotalCriticos, «</div>», «»)
TotalCriticos = Replace(TotalCriticos, «<div style=float:right; text-align:center><span class=number-table style=color:red >», «»)
Posi3 = InStr(TotalCriticos, «</span>»)
TotalCriticos = Left(TotalCriticos, Posi3 – 1)
TotalCriticos = Replace(TotalCriticos, Chr(32), «») ‘elimina espacio blanco
TotalCriticos = Replace(TotalCriticos, Chr(10), «») ‘elimina tabulaciones

‘Total de Casos Cerrados
Principio = «Closed Cases</span>»
Final = «<div style=»»font-size:13.5px»»>Cases which had an outcome:»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerrado = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerrado = Replace(TotalCerrado, Chr(34), «») ‘elimina comillas
TotalCerrado = Replace(TotalCerrado, «</div>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel-body style=text-align:center;height:200px;>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel_flip>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=panel_front style=width:100%;height:100%;>», «»)
TotalCerrado = Replace(TotalCerrado, «<div class=number-table-main>», «»)
Posi3 = InStr(TotalCerrado, «</div>»)
TotalCerrado = Left(TotalCerrado, Posi3 – 1)
TotalCerrado = Replace(TotalCerrado, Chr(32), «») ‘elimina espacio blanco
TotalCerrado = Replace(TotalCerrado, Chr(10), «») ‘elimina tabulaciones

‘Total de Recuperados
Principio = «Cases which had an outcome:</div>»
Final = «<div style=»»font-size:13px»»>Recovered»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerradoRecuperados = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(34), «») ‘elimina comillas
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<div style=padding-top:20px >», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<div style=float:left; text-align:center>», «»)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, «<span class=number-table style=color:#8ACA2B>», «»)
Posi3 = InStr(TotalCerradoRecuperados, «</span>»)
TotalCerradoRecuperados = Left(TotalCerradoRecuperados, Posi3 – 1)
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(32), «») ‘elimina espacio blanco
TotalCerradoRecuperados = Replace(TotalCerradoRecuperados, Chr(10), «») ‘elimina tabulaciones

‘Total de Muertos
Principio = «Recovered / Discharged</div>»
Final = «<div style=»»font-size:13px»»>Deaths»
Posi1 = InStr(MyRespu, Principio)
Posi2 = InStr(MyRespu, Final)
dato = Mid(MyRespu, Posi1, (Posi2 – Posi1))
TotalCerradoMuertos = Replace((Replace(dato, Principio, «»)), «,», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(34), «») ‘elimina comillas
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «<br>», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «</div>», «»)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, «<div style=float:right; text-align:center><span class=number-table>», «»)
Posi3 = InStr(TotalCerradoMuertos, «</span>»)
TotalCerradoMuertos = Left(TotalCerradoMuertos, Posi3 – 1)
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(32), «») ‘elimina espacio blanco
TotalCerradoMuertos = Replace(TotalCerradoMuertos, Chr(10), «») ‘elimina tabulaciones

UserForm1.ProgressBar1.Value = 80
UserForm1.Label1.Caption = «80 %»
DoEvents

b.Range(«F2») = Lastupdate
Application.EnableEvents = False
b.ComboBox2 = Lastupdate

b.Range(«D7») = TotalCasos
b.Range(«D8») = TotalMuertos
b.Range(«D9») = TotalRecuperados

b.Range(«D12») = TotalInfectados
b.Range(«D13») = TotalLeves
b.Range(«D14») = TotalCriticos

b.Range(«D17») = TotalCerrado
b.Range(«D18») = TotalCerradoRecuperados
b.Range(«D19») = TotalCerradoMuertos

uf = a.Range(«A» & Rows.Count).End(xlUp).Row + 1
a.Range(«A2:I» & uf).Copy
b.Range(«A22»).PasteSpecial xlPasteValues

b.Range(«A21») = «País»
b.Range(«B21») = «Casos»
b.Range(«C21») = «Nuevos Casos»
b.Range(«D21») = «Muertes»
b.Range(«E21») = «Nuevas Muertes»
b.Range(«F21») = «Recuperados»
b.Range(«G21») = «Casos Activos»
b.Range(«H21») = «Casos Criticos»
b.Range(«I21») = «Casos/1M Pob»

uf = b.Range(«A» & Rows.Count).End(xlUp).Row – 1
For x = 3 To 9
For j = 22 To uf
If b.Cells(j, x) = Empty Then b.Cells(j, x) = 0
Next j
Next x

UserForm1.ProgressBar1.Value = 90
UserForm1.Label1.Caption = «90 %»
DoEvents

‘uf = b.Range(«A» & Rows.Count).End(xlUp).Row
‘For x = 23 To uf Step 2
‘b.Range(«A» & x & «:I» & x).Interior.Color = 13082801 ‘morado claro 13082801 ‘5296274 verde claro
‘Next x
‘b.Range(«A» & uf & «:I» & uf).Font.Bold = True
Call Formato

Application.DisplayAlerts = False
Application.ScreenUpdating = False
‘MsgBox («Los datos se han importado con éxito » & b.Range(«E2»)), vbInformation, «AVISO»
a.Delete
b.Select
Range(«A1»).Select

UserForm1.ProgressBar1.Value = 100
UserForm1.Label1.Caption = «100 %»
DoEvents

Unload UserForm1
Application.StatusBar = Clear
‘Application.EnableEvents = True
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Public Sub WriteTable(ByVal MyTable As Object, Optional ByVal StarR As Long = 1, Optional ByVal Ws As Worksheet)
Dim tSection As Object, tRow As Object, tCell As Object, tr As Object, td As Object, R As Long, C As Long, tBody As Object
Dim Titulos As Object, Titulo As Object, CantCol As Long

If Ws Is Nothing Then Set Ws = ActiveSheet
R = StarR
With ActiveSheet
Set Titulos = MyTable.getElementsByTagName(«th»)
For Each Titulo In Titulos
CantCol = CantCol + 1
.Cells(StarR, CantCol) = Titulo.innerText
Next Titulo
StarR = StarR + 1
Set tBody = MyTable.getElementsByTagName(«tbody»)
For Each tSection In tBody ‘HTMLTableSection
Set tRow = tSection.getElementsByTagName(«tr») ‘HTMLTableRow
For Each tr In tRow
R = R + 1
Set tCell = tr.getElementsByTagName(«td»)
C = 1
For Each td In tCell ‘DispHTMLElementCollection
.Cells(R, C).Value = td.innerText ‘HTMLTableCell
C = C + 1
Next td
Next tr
Next tSection
End With
End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Donate:
Cuenta Paypal: https://paypal.me/programarexcel
Cuenta Bitcoin: 1KBGGb8fyDzyR3X1Rie6m7VguzaAfngNbd
Cuenta Ether: 0x41Bbd24556914C83a31217eBb3BC49789b66e407

Summary
Author Rating
1star1star1star1star1star
Aggregate Rating
no rating based on 0 votes