Importer plusieurs tableaux web

[sam20lionel]

Bonjour,

J'ai à nouveau besoin de votre aide. En effet, je recherche à importer plusieurs tableaux d'un site sur excel 2007. Pour le moment j'arrive à importer un par un les tableaux, et je suis actuellement en train de créer plusieurs long macros pour tout importer.

Cependant, j'aurai voulu savoir s'il était possible d'importer plusieurs tableaux de différentes pages web en un coup (ou un peu +), à l'aide d'un macro ou autre. Le site contient environ 1600 pages de tableaux et les tableaux ont une cinquantaine de ligne et 5 colonnes. De plus je souhaiterai également savoir s'il était possible de présenter les données de l'importation de manière verticale, càd que chaque tableau va en dessous de l'autre automatiquement.

Merci d'avance pour votre aide.

[Usb512]

Salut le forum

Il faudrait voir la structure du site Web, l'emplacement des tableaux à récupérer.

Ensuite on pourra voir pour te batir une macro qui te feras l'importation dans Excel.

A te relire
Mytå

[sam20lionel]

Bonjour,

Voici le site ICI. C'est donc la 1ere page. Et sa dernière page ICI.

Merci.

[vba-new]

Bonjour à tous,

Essaie avec ce code (fait avec l'enregistreur de macro puis modifié) :

Code: Tout sélectionner

Sub rapatrie()
Dim i As Long
Dim finTableau As Long
Dim numFeuille As Byte
    Application.ScreenUpdating = False
    numFeuille = 1
    For i = 150 To 83100 Step 50
        finTableau = Range("A65536").End(xlUp).Row
        If finTableau + 50 < 65536 Then
            With ActiveSheet.QueryTables.Add(Connection:= _
                                             "URL;http://www.slayersonline.net/communaute/player.php?offset=" & i, _
                                             Destination:=Range("A" & finTableau))
                .Name = "player.php?offset=" & i
                '.RowNumbers = False
               '.FillAdjacentFormulas = False
               '.PreserveFormatting = True
               '.RefreshOnFileOpen = False
               '.BackgroundQuery = True
               .RefreshStyle = xlOverwriteCells
                '.SavePassword = False
               '.SaveData = True
               '.AdjustColumnWidth = True
               '.RefreshPeriod = 0
               .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "2"
                '.WebPreFormattedTextToColumns = True
               '.WebConsecutiveDelimitersAsOne = True
               '.WebSingleBlockTextImport = false
               '.WebDisableDateRecognition = False
               '.WebDisableRedirections = False
               .Refresh BackgroundQuery:=False
            End With
        Else
            numFeuille = numFeuille + 1
            Sheets(numFeuille).Activate
        End If
    Next i
    For numFeuille = 1 To Sheets.Count
        With Sheets(numFeuille)
            For i = .Cells(65536, 1).End(xlUp).Row To 1 Step -1
                If .Cells(i, 1) = "#" Then .Rows(i).Delete
            Next i
        End With
    Next numFeuille
End Sub
 

Fais attention c'est très long vu qu'il y a plus de 1600 pages!

J'ai fait en sorte que si on dépasse le nombre max de lignes d'une feuille on passe à la feuille suivante.
J'ai également mis un bout de code qui supprime les entêtes de colonnes.
Lance la macro à partir d'un classeur vierge, c'est plus sûr.

Ce code doit être optimisable par de plus aguerris que moi

[sam20lionel]

Enfin le chargement est fini.

C'est presque parfait, merci. Le petit soucis est que, la 1ere page et la 2e page ne sont pas prises en compte. Le classement commence donc à partir de la troisième page (soit 151).

Auriez vous une solution pour y remédier?

Et, si je veux utiliser cette macro, dans un second temps, en la modifiant, avec d'autres tableaux du même site, quels sont les parties dans le code à modifier? (Juste l'url et "For i"?) Les tableaux sont les mêmes mais les chiffres sont différents.

Merci.

[vba-new]

Ah effectivement!

Pour commencer de la 1ere page, t'as juste à remplacer :

Code: Tout sélectionner

For i = 150 To 83100 Step 50

par

Code: Tout sélectionner

For i = 0 To 83100 Step 50

Pour utiliser le tableau avec d'autres sites ça dépend de l'URL.

S'il y a une partie de l'URL qui est fixe et une partie qui s'incrémente (comme dans le premier cas) alors oui tu dois changer l'URL et le for i.

Enlève également le

Code: Tout sélectionner

.Name = "player.php?offset=" & i

qui n'a pas l'air de servir.

Quant à la partie :

Code: Tout sélectionner

For numFeuille = 1 To Sheets.Count
        With Sheets(numFeuille)
            For i = .Cells(65536, 1).End(xlUp).Row To 1 Step -1
                If .Cells(i, 1) = "#" Then .Rows(i).Delete
            Next i
        End With
    Next numFeuille

elle permet de supprimer les entêtes (efface les lignes contenant "#").

[sam20lionel]

Tout est parfait !

Merci de votre aide.

[sam20lionel]

Bonjour,

Cette macro a longtemps marché et pourtant depuis quelques mois il rencontre quelques difficultés. Seuls 2 ou 3 pages du site en question sont prises en compte. Voici le code en fonction d'une autre page, plus rapide à charger, qui auparavant marchait bien.

Code: Tout sélectionner


Sub rapatrie()
Dim i As Long
Dim finTableau As Long
Dim numFeuille As Byte
    Application.ScreenUpdating = False
    numFeuille = 1
    For i = 0 To 1850 Step 50
        finTableau = Range("A65536").End(xlUp).Row
        If finTableau + 50 < 65536 Then
            With ActiveSheet.QueryTables.Add(Connection:= _
                                             "URL;http://www.slayersonline.net/communaute/listeguildegold.php?offset=" & i, _
                                             Destination:=Range("A" & finTableau))
                '.RowNumbers = False
               '.FillAdjacentFormulas = False
               '.PreserveFormatting = True
               '.RefreshOnFileOpen = False
               '.BackgroundQuery = True
               .RefreshStyle = xlOverwriteCells
                '.SavePassword = False
               '.SaveData = True
               '.AdjustColumnWidth = True
               '.RefreshPeriod = 0
               .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingNone
                .WebTables = "2"
                '.WebPreFormattedTextToColumns = True
               '.WebConsecutiveDelimitersAsOne = True
               '.WebSingleBlockTextImport = false
               '.WebDisableDateRecognition = False
               '.WebDisableRedirections = False
               .Refresh BackgroundQuery:= False
            End With
        Else
            numFeuille = numFeuille + 1
            Sheets(numFeuille).Activate
        End If
    Next i
    For numFeuille = 1 To Sheets.Count
        With Sheets(numFeuille)
            For i = .Cells(65536, 1).End(xlUp).Row To 1 Step -1
                If .Cells(i, 1) = "#" Then .Rows(i).Delete
            Next i
        End With
    Next numFeuille
End Sub
 

D'après excel 2007, le problème viendrait de ce code:

Code: Tout sélectionner

.Refresh BackgroundQuery:= False

Pourtant celui marchait il y a quelques mois!

Auriez vous une solution?

Merci d'avance!

[vba-new]

Bonsoir sam20lionel, forum,

Je viens de faire un certain nombre de tests mais j'ai bien peur de ne pas savoir d'où pourrait provenir l'erreur ! Espérons que quelqu'un aura plus de succès !

[sam20lionel]

Bonjour,

Merci d'avoir essayé. C'est quand même bizarre, cela marchait il y a quelques mois, et le site en question n'a subi aucune modification.