Importar tabla de una Web

Quiero importar una tablas de una web a Excel para realizar unos análisis, pero me las coge en vertical, ¿cómo podría hacerlo?
http://asobal.es/equipos_estadisticas_equipo.php

3

3 Respuestas

2.209.115 pts. En mi sitio encontraran material de ayuda, ejemplos...

Efectivamente como comenta el usuario anterior no está en formato tabla pero podemos obtenerla con una macro.

Cuando capturas esta hoja se te colocan más celdas de las necesarias, por eso tendrás que borrar todo lo innecesario antes. Luego en la macro ajusta el nro de fila inicial. Por ahora la dejé en 28 que es como la obtuve sin hacer el borrado.

Sub transponerTablaWeb()
'x Elsamatilde
'inicio del rango: fila 28 (ajustar)
orig = 28: desti = 28
'se recorre la col A desde fila 28 hasta la última con datos
finx = Range("A" & Rows.Count).End(xlUp).Row
'se repite el bucle cada 10 celdas
For i = orig To finx Step 10
    'se copia el rango de 10 celdas pegando transpuesto a partir de col C
    Range("A" & i & ":A" & i + 9).Copy
    Range("C" & desti).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    'se incrementan las filas de cada col
   desti = desti + 1
Next i
End Sub

Entra al Editor de macros (con ALT + F11)

Inserta un módulo y allí copia el código.

Podrás ejecutarlo desde el mismo Editor o desde la hoja, menú Desarrollador, Macros. Podrás utilizar otras opciones de cómo ejecutar macros que las tengo explicadas en mi sitio web que dejo al pie.

Como dices: importar una tablas de una web a Excel asumo que lo haces con la opción de Obtener datos externos, desde Web.

Entonces obtienes una lista en 1 sola columna como se observa en la imagen.

Si la dejas tal cual al iniciar la macro, las filas de origen y destino empiezan en la 28 (orig = 28: desti = 28) y se va transponiendo de a 10 filas que es lo que ocupa la 1er tabla.

Pero como entre las 2 tablas hay algunas celdas que no necesitas y que no ocupan 10 filas sino más, las tenés que quitar antes de ejecutar la macro para que siga existiendo una diferencia de 10 entre cada equipo.

Sdos!

74.100 pts.

.

:)

Esa página es ineficiente y -encima- no te brinda la info en un formato de tabla "real". Por ello vas a tener que resolver el tema con "cirugía mayor" (una macro) como la que adjunto:

Sub extrae_Datos()
Dim xml, HtmlDoc, mZI, mDiv, iDiv, ws As Worksheet
Dim Url, Dic, i&, j%, C As Range
Application.ScreenUpdating = False
Url = "http://asobal.es/equipos_estadisticas_equipo.php"
Set xml = CreateObject("Microsoft.XMLHttp")
xml.Open "Get", Url, False   'petición sincrónica
xml.Send
Set HtmlDoc = CreateObject("HTMLFile")
HtmlDoc.body.innerHTML = caracteres_Especiales(xml.responseBody)
Set mZI = HtmlDoc.getElementByID("zona_izquierda")
Set mDiv = mZI.getElementsByTagName("div")
Set Dic = CreateObject("Scripting.Dictionary")
i = 0
For Each iDiv In mDiv
  i = 1 + i
  Set Dic(i) = iDiv
Next
Set ws = Workbooks.Add.Sheets(1)
ws.[a1] = "JUGADORES DE CAMPO"
i = 1
Do
  If i >= Dic.Count Then Exit Do
  Do Until Dic(i).ID = "fila_1_listado_jugadores" And Trim(Dic(i).innerText) <> ""
    i = 1 + i
    DoEvents
  Loop
  Set C = ws.Cells(Rows.Count, "a").End(xlUp)
  C.Cells(2, 1) = Dic(i).innerText
  j = 0
  Do Until j = 9
    i = 1 + i
    Do Until Dic(i).ID = "cabecera_listado_jugadores" And Trim(Dic(i).innerText) <> ""
      i = 1 + i
      DoEvents
    Loop
    j = 1 + j
    C.Cells(2, 1 + j) = Dic(i).innerText
  Loop
  i = 1 + i
  DoEvents
Loop
With ws.[a1].CurrentRegion
  .Columns("g:j").NumberFormat = "0;;""---"""
  .Columns.AutoFit
  With .Rows(1)
    .HorizontalAlignment = xlCenterAcrossSelection
    .Font.Size = 14
    .Offset(1).Insert
  End With
End With
Set C = ws.Columns(2).Find("L 9M", After:=ws.[b5], LookIn:=xlValues, LookAt:=xlWhole).Offset(, -1)
C.EntireRow.Insert
C.EntireRow.Insert
With C.CurrentRegion
  C(1).Offset(-1) = "ARQUEROS"
  With .Rows(1).Offset(-1)
    .HorizontalAlignment = xlCenterAcrossSelection
    .Font.Size = 14
    .Offset(1).Insert
  End With
End With
With ws.ListObjects.Add(xlSrcRange, ws.[a3].CurrentRegion, , xlYes)
  .TableStyle = "TableStyleMedium15"
  .Range.AutoFilter
End With
With ws.ListObjects.Add(xlSrcRange, C.CurrentRegion, , xlYes)
  .TableStyle = "TableStyleMedium15"
  .Range.AutoFilter
End With
Application.ScreenUpdating = True
End Sub
Private Function caracteres_Especiales(mTxt) As String
With CreateObject("ADODB.Stream")
    .Type = 1 ' adTypeBinary
    .Open
    .Write mTxt
    .Position = 0
    .Type = 2 ' adTypeText
    .Charset = "iso-8859-1"
    caracteres_Especiales = .ReadText
End With
End Function

Espero te sea de utilidad, Mario (Cacho) Rodríguez.

:)

.

Gracias Mario, también quiero hacer lo mismo pero de este enlace, http://asobal.es/equipos_estadisticas.php?id=1 

:)
Plantea esta nueva duda en una nueva pregunta.

Y no olvides comentar cuales han sido tus intentos para entender donde es que está fallando tu adaptación de lo mostrado.

Saludos, Mario (Cacho) Rodríguez.
:)

174.955 pts. O eres parte de la solucion, o eres parte del problema.

Si miras el código no es una tabla, sino que son cajas (div) con anchos fijos para que parezca una tabla, vamos una chapuza de cuidado. Por eso excel no lo reconoce.

Tendrás que hacerlo a mano, uno por uno.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas