Importer plusieurs tableaux web
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.
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å
Bonjour à tous,
Essaie avec ce code (fait avec l'enregistreur de macro puis modifié) :
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 SubFais 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
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.
Ah effectivement!
Pour commencer de la 1ere page, t'as juste à remplacer :
For i = 150 To 83100 Step 50 par
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
.Name = "player.php?offset=" & i qui n'a pas l'air de servir.
Quant à la partie :
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 "#").
Tout est parfait !
Merci de votre aide.
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.
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:
.Refresh BackgroundQuery:= FalsePourtant celui marchait il y a quelques mois!
Auriez vous une solution?
Merci d'avance!
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 !
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.
Je me permets de faire remonter un peu le sujet.
Un petit up une nouvelle et dernière fois.