Macro Importation Données plusieurs pages web
Bonsoir,
Très pratique ton fichier Steelson, je me suis permis de le télécharger pour essayer de le comprendre car j'ai un niveau moyen sur excel et proche du zéro pour VBA, mais j'y travaille !
J'ai le projet de récupérer l'historique des matchs de foot de la ligue 1 et de la ligue 2 depuis 2010 dans un fichier excel (1 onglet par ligue) avec possibilité de mise à jour après chaque journée. J'ai essayé de m'inspirer de tes macros, mais le code de la page en exemple ci dessous ne me permet à priori pas de réaliser l'extraction!
http://www.pronosoft.com/fr/parions_sport/resultats-parions-sport-plein-ecran.htm?date=16-01-2010je te joins un fichier exemple du résultat voulu.
Par le passé je réalisais des copier/coller et traitais les données manuellement, ce qui était long et fastidieux
J'espère que tu pourras m'apporter ton aide et m'aider à progresser dans excel.
Bonsoir
Je jette un œil demain
Cool, je te remercie
bonne soirée
Hello !
Voici pour ce qui est de l'interrogation et la récupération complète du tableau.
bonjour et merci pour ta réactivité.
Le score des matchs est parfois transformé au format date, aurais tu une solution pour corriger cela ?
Le tri par compétition est il possible (1 onglet par compétition) ?
Bjr,
j'ai essayé différentes solutions, en particulier mettre les cellules au format texte avant de copier, mais rien n'y fait !! effectivement certaines cellules passent en date ...
comment faisais-tu manuellement pour copier ? il y a peut-être là une solution alors ?
Re,
Ca fait longtemps que je ne l'ai pas fait, mais si je me souviens le copier coller fonctionnait sur excel 2007, mais pas sur une version plus récente
J'ai enregistré une macro lors de l'import des données su site ou j'ai sélectionné ne pas reconnaitre les dates
Je te joins le fichier avec la macro
La commande semble être la suivante :
.WebDisableDateRecognition = True
Je sais pas si elle serait utile dans ton code ?
J'ai ajouté ceci pour leurrer le système
txt = Replace(txt, "-", " - ")vérifie pour voir ...
Quant à WebDisableDateRecognition = True, il semble que cela fonctionne avec QueryTableque je n'ai jamais essayé.
je vais me pencher sur une telle solution que j'ai vu apparaître dans ton fichier mais sans garantie (on va voir ...)
Fiftygreg a écrit :Le tri par compétition est il possible (1 onglet par compétition) ?
heu, faut que je regarde
où trouve-t-on cette information ?
ok pour la correction pour le score, ca à l'air de fonctionner.
tri par compétition :
quand j'utilise ton fichier et que je lance la macro, l'info se trouve en colonne C, tu as d'abord les 2 équipes puis la ligue.
Il y a aussi un petit souci avec la colonne I qui renvoit et le prono du site (qui ne m'intéresse pas) et le résultat du match (que je veux récupérer). Il s'agit du dernier caractère de chaque cellule de la colonne I.
Pour le moment la macro extrait tout (toutes les ligues de tous les sports) et je voudrai si possible filtrer les 2 ligues françaises de football (ligue 1 et ligue 2). Le must serait d'obtenir les résultats dans des onglets différents comme montré dans mon premier fichier.
le hic, car il y en a au moins 1
voir partidu code de la page ci dessous !
<tr class="m-s-0 m-c-14 m-235737" style="display: table-row;"><td class="hide_0" onclick="HidePSMatch(235737, true);"></td><td class="h sep">
<input name="match_id" type="hidden" value="235737">
19h55</td>
<td class="match sep">
<a class="infos" href="javascript:void(0);"><span class="sport football" style="display: none;"></span>AC Ajaccio-Châteauroux
<span class="details-ps">
<strong><img alt="Ligue 2" src="/images/logos/pays/france_18x12.gif"> Ligue 2</strong>14ème journée entre le 2ème et le 14ème (sur 20) - Limités dans l'ensemble, les Castelroussins se rendent en Corse où Ajjacio peut s'y targuer de cinq victoires en six sorties. <br><br>Score Final : 1-2 | Statut FDJ : encaissable<br>Score [0:1] : 1-3 | Statut FDJ : encaissable<br>Score Mi-T. : 0-1 | Statut FDJ : encaissable</span>
</a>
</td>
<td class="res sep">1-2</td><td class="nr">
<span class="encaissable">115</span>
</td><td><span class="baisse">1,65</span></td><td><span class="hausse">3,50</span></td><td><span class="res_c res_hausse">4,85</span></td><td class="prono sep">
<span class="prono prono_ps prono_false">1</span>
<span class="prono res_fdj" style="display: none;">2</span>
</td>un peu galère à comprendre à mon niveau !
le but final étant de pouvoir boucler depuis le 01/10/2010 à aujourd'hui pour faire un listing complet de ses 2 ligues, et de prévoir la mise à jour ( possibilité de faire un fichier par ligue si c'est plus simple)
j'espère que se sera clair pour toi, et encore merci pour le temps que tu me consacres
à peaufiner peut-être encore ...
Version plus "propre"
précision = dans le dernier fichier, tu peux mettre à la file plusieurs adresses internet (plusieurs dates) en mettant en colonne A ce que tu veux mais qui reflète les pages visitées, les données Ligue 1 et Ligue 2 seront mises à la file les unes des autres.
Bonsoir,
Merci Steelson, je vais tester ca ce week end.
bon week end
Bonjour,
j'ai testé et soit je ne rentre pas les bonnes infos au bon endroit soit ca ne fonctionne pas
les mêmes matchs apparaissent en boucle avec un décalage dans l'affichage du score.
une idée pour corriger ca ?
Bjr,
mets juste ceci en A1
<table class="cotes sortable" id=cela fonctionne
Explication du code
Sub Maj()
' pour calculer le temps d'exécution
timedebut = Now()
' pour éviter les demandes de confirmation de suppression de feuilles
' et gagner en tempss d'exécution
With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
' on supprime toutes les feuilles et on recrée "Ligue 1" et "Ligue 2"
For Each ws In ActiveWorkbook.Worksheets
With ws
If .Name <> "Interrogation" Then ws.Delete
End With
Next
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Ligue 1"
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "Ligue 2"
Sheets("Interrogation").Activate
Dim i%, k%, URL$, obj As New DataObject
k = Cells(Rows.Count, [www].Column).End(xlUp).Row
On Error Resume Next
' boucle sur les adresses internet
For i = [debut].Row + 1 To k
DoEvents
URL = Sheets("Interrogation").Cells(i, [www].Column).Value
On Error Resume Next
' on interroge les sites
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
' test de la fin du chargement de la page web
If .Status = 200 Then
' on récupère le contenu de la page dans .responseText
' on ne retient que le texte entre "avant" et "apres" (voir cellules au nom correspondant)
txt = [avant] & Split(Split(.responseText, [avant])(1), [apres])(0) & [apres]
' on remplace le - pour éviter l'interprétation des résultats en date
txt = Replace(txt, "-", " - ")
obj.SetText txt
' on colle dans le presse papier
obj.PutInClipboard
' on ajoute une feuille temporaire dans laquelle on colle le contenu du presse-papier
ActiveWorkbook.Sheets.Add Before:=Worksheets(Worksheets.Count)
ActiveSheet.Paste
ActiveSheet.Name = "temp"
Cells.Select
Cells.EntireColumn.AutoFit
Cells.EntireRow.AutoFit
' report des valeurs sur feuilles "Ligue 1" et "Ligue 2"
ligues ("temp")
' suppression de la feuille temporaire
Sheets("temp").Delete
End If
End With
Next
' mise en forme colonnes de "Ligue 1" et "Ligue 2"
With Sheets("Ligue 1")
.Cells.Select
.Cells.EntireColumn.AutoFit
End With
With Sheets("Ligue 2")
.Cells.Select
.Cells.EntireColumn.AutoFit
End With
Sheets("Interrogation").Activate
With Application
.ScreenUpdating = True
.DisplayAlerts = True
End With
MsgBox ("Terminé en " & Format((Now() - timedebut), "n' ss''") & " !")
End Sub
Sub ligues(ceNom)
With Sheets(ceNom)
' report des valeurs sur feuille "Ligue 1"
For i = 1 To .[C65000].End(xlUp).Row
Sheets("Ligue 1").Select
If .Cells(i, "C").Value Like "*Ligue 1*" Then
der = Sheets("Ligue 1").Cells(65000, "C").End(xlUp).Row + 1
Sheets("Ligue 1").Cells(der, "A") = ceNom
Sheets("Ligue 1").Cells(der, "B") = Mid(.Cells(i, "C"), 1, InStr(1, .Cells(i, "C"), "Ligue") - 2)
.Range(.Cells(i, "D"), .Cells(i, "T")).Copy
Sheets("Ligue 1").Cells(der, "C").Select
Sheets("Ligue 1").Paste
End If
Next
' report des valeurs sur feuille "Ligue 2"
For i = 1 To .[C65000].End(xlUp).Row
Sheets("Ligue 2").Select
If .Cells(i, "C").Value Like "*Ligue 2*" Then
der = Sheets("Ligue 2").Cells(65000, "C").End(xlUp).Row + 1
Sheets("Ligue 2").Cells(der, "A") = ceNom
Sheets("Ligue 2").Cells(der, "B") = Mid(.Cells(i, "C"), 1, InStr(1, .Cells(i, "C"), "Ligue") - 2)
.Range(.Cells(i, "D"), .Cells(i, "T")).Copy
Sheets("Ligue 2").Cells(der, "C").Select
Sheets("Ligue 2").Paste
End If
Next
End With
End SubC'est parfait, j'ai fait le test sur 1 week end et c'est bon.
j'essaierai ce soir de récupérer une saison complète !
encore un grand merci à toi
un peu plus d'explication sur la méthode ...
je me suis rendu compte que recopier un tableau sur excel était correctement interprêté
mais qu'il fallait passer par cela par le presse-papier (exemple quand on copie à l'écran un bout de page web)
ce fut une grande bataille à l'époque pour récupérer en masse des données d'un logiciel (EVREST http://evrest.istnf.fr/page-44-0-0.html)
le but est donc de récupérer un bout de la réponse .responseText de la requête englobant les balises <table ....> et </table>
de copier ce bout de réponse dans le presse-papier
et de coller sur un onglet (ici temp)