Titre du sujet : Re: Extraction de données sur pages web
par myDearFriend! le 07/10/2009 00:13:11
Bonsoir Icedarts 
Pas très inspiré en ce soir, je me contente de traiter ton problème selon la méthode... rustine.
Tu trouveras ton classeur modifié selon ma façon de voir les choses.
J'ai utilisé le code suivant qui remplacera ton ancienne procédure Traitement() :
Option Explicit
'----------------------------------------------------------------------------
' Auteur : Didier FOURGEOT (myDearFriend!) - www.mdf-xlpages.com
'----------------------------------------------------------------------------
Public EnCours As Boolean 'Flag pour contrôle de chargement page Web
Sub Traitement()
Dim TabTemp As Variant
Dim T As String, T1 As String, T2 As String
Dim L As Long, L2 As Long, Lign As Long
Dim Col As Byte
'On efface les données de la Feuil2
With Sheets("Feuil2")
.Range(.Cells(2, 1), .Cells(.Rows.Count, 12)).Delete
.Range(.Cells(2, 1), .Cells(2, 8)).Interior.ColorIndex = 3
End With
'Traitement
With Sheets("Feuil1")
'Pour chaque lien
For L = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
'On affiche la page Web dans le WebBrowser
EnCours = True
.WebBrowser1.Navigate .Cells(L, 1).Text
'Le flag "EnCours" est remis à False dans Feuil1 > WebBrowser1_DocumentComplete()
Do
DoEvents
Loop Until EnCours = False
'
T = .WebBrowser1.Document.Body.InnerText()
T1 = "Matchs Class.GR Class.Opé Games PPD.301 MPR.CRI Moy/match "
T2 = Replace(T1, " ", vbCrLf)
T = Replace(T, T1, T2)
'On récupère les données de chaque tableau
TabTemp = Split(T, vbCrLf)
Col = 0
With Sheets("Feuil2")
'Prochaine ligne "résultat"
Lign = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Cells(Lign, 14) = Mid(TabTemp(2), 1) 'Groupe
'Données du tableau
For L2 = 3 To UBound(TabTemp)
Col = Col + 1
If Col > 9 Then
Col = 1
Lign = Lign + 1
.Cells(Lign, 14) = Mid(TabTemp(2), 1) 'Groupe
If TabTemp(L2) Like "Equipe :*" Then
.Range(.Cells(Lign, 1), .Cells(Lign, 8)).Interior.ColorIndex = IIf(TabTemp(L2 + 1) = "Matchs", 3, 33)
End If
End If
.Cells(Lign, Col).Value = TabTemp(L2)
Next L2
End With
Next L
End With
Sheets("Feuil2").Columns("A:H").EntireColumn.AutoFit
MsgBox "Traitement terminé !"
End Sub
Cordialement,
|
Didier FOURGEOT