Valeurs multiples dans code HTML dont les balises sont identiques
Bonjour,
Je tente de récupérer les 3 valeurs ci-dessous : ( 0,5 / 0,6 / 0,7 )
<tr class="c-table__row c-table-evolution__row-top">
<td class="c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-normal-whitespace">
Dividende<br>
par action
</td>
<td class="c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis">
0,50
<span class="c-table-evolution__suffix">EUR</span>
</td>
<td class="c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis">
0,60
<span class="c-table-evolution__suffix">EUR</span>
</td>
<td class="c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis">
0,70
<span class="c-table-evolution__suffix">EUR</span>
</td>
</tr>
Pour cela j'utilise ce code :
avant = "<td class=""c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis"">"
apres = "</td>"
Du coup il ne me prend toujours que la première ligne qu'il trouve et me donne "0,5"
Y a il un moyen pour lui dire que parmi les 3 lignes identiques je souhaite la première, le deuxième ou la troisième ?
Merci pour ceux qui pourrons m'aider à comprendre :-)
Bonjour,
Veuillez utiliser les balises de mise en forme des messages pour tout ce qui est code ou autre, merci. Pour les codes la balise est : </>
Et un petit bout de fichier (pas un imprime écran) serait le bienvenu.
@ bientôt
LouReeD
Sub MajRendements()
Sheets("COTATIONS").Select
Dim i%, k%, URL$, VALOR, pera, perb, perc
k = Cells(Rows.Count, [REF].Column).End(xlUp).Row
Range(Cells(2, [per2k23].Column), Cells(k, [per2k23].Column)).Clear
Range(Cells(2, [per2k24].Column), Cells(k, [per2k24].Column)).Clear
Range(Cells(2, [per2k25].Column), Cells(k, [per2k25].Column)).Clear
avant = "<td class=""c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis"">"
apres = "<span"
On Error Resume Next
For i = 2 To k
DoEvents
ReDim pera(1 To k, 1 To 1)
pera(1, 1) = Cells(i, [per2k23].Column).Value
URL = Cells(i, [www].Column).Value
Application.StatusBar = "Mise à jour du PER 2023 en cours …"
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then pera(i, 1) = Val(Replace((Split(Split(.responsetext, avant)(1), apres)(0)), ",", "."))
End With
Application.StatusBar = False
Cells(i, [per2k23].Column).Value = pera(i, 1)
Next
avant = "<td class=""c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis"">"
apres = "<"
On Error Resume Next
For i = 2 To k
DoEvents
ReDim perb(1 To k, 1 To 1)
perb(1, 1) = Cells(i, [per2k24].Column).Value
URL = Cells(i, [www].Column).Value
Application.StatusBar = "Mise à jour du PER 2024 en cours …"
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then perb(i, 1) = Val(Replace((Split(Split(.responsetext, avant)(1), apres)(0)), ",", "."))
End With
Application.StatusBar = False
Cells(i, [per2k24].Column).Value = perb(i, 1)
Next
avant = "<td class=""c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis"">"
apres = "</td>"
On Error Resume Next
For i = 2 To k
DoEvents
ReDim perc(1 To k, 1 To 1)
perc(1, 1) = Cells(i, [per2k25].Column).Value
URL = Cells(i, [www].Column).Value
Application.StatusBar = "Mise à jour du PER 2025 en cours …"
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then perc(i, 1) = Val(Replace((Split(Split(.responsetext, avant)(1), apres)(0)), ",", "."))
End With
Application.StatusBar = False
Cells(i, [per2k25].Column).Value = perc(i, 1)
Next
Next
Sheets("ANALYSE TECHNIQUE").Select
ActiveWorkbook.RefreshAll
End SubBonjour,
désolé si ce n'est pas clair :-)
c'est une macro dans un fichier excel
la page source par exemple : https://www.boursorama.com/cours/1rPRMS/
le code ci-dessus
Je récupéré les valeurs suivantes :
Est ce plus claire comme ca ? :-)
Je me pose la question de l'autorisation que ce site donne à "l'aspiration" des données, car dans la charte du site ici il est bien dit :
Ne demandez rien d'illégal ou d'éthiquement discutable (comme par exemple le retrait d'un mot de passe VBA, l'extraction de données d'un site qui ne l'autorise pas, etc).
Alors...
Et c'est le genre de sujet pour lequel je ne maitrise pas grand chose... Désolé.
@ bientôt
LouReeD
bonjour le fil,
un essai
Sub MajRendements()
Dim Arr
avant = "<td class=""c-table__cell c-table__cell--dotted c-table__cell--inherit-height c-table__cell--align-top / u-text-left u-text-right u-ellipsis"">"
apres = "<span"
URL = "https://www.boursorama.com/cours/1rPRMS/"
Application.StatusBar = "Mise à jour du PER 2023 en cours …"
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
sp = Split(.responsetext, avant, , 1)
If UBound(sp) > -1 Then
sp(0) = ""
fl = Filter(sp, apres, 1, 1)
ReDim Arr(UBound(fl))
For i = 0 To UBound(fl)
Arr(i) = Trim(Split(fl(i), vbLf)(1))
Next
End If
End If
End With
MsgBox Join(Arr, vbLf)
End SubMerci beaucoup BsAlv pour votre réponse .
Pouvez vous me décrire votre syntaxe ( ou du moins son fonctionnement ) afin que je comprenne comment l'intégrer ?
si je place ce bloc pour le PER 2023 à quoi ressemblera le bloc pour le chiffre de 2024 ?
Merci encore
Bonjour
l'analyse d'un code html en string n'a jamais (pour aussi loin que je me souvienne) été une bonne idée
pour la simple et bonne raison c'est que du jour au lendemain le code OUTERHTML PEUT CHANGER
ET JE DIS BIEN LE OUTERHTML(tout ce qui est properties html ;classe , style et autres attributs donnés aux éléments html)
on analyse un document html avec le DOM (Document Object Model)
donc là en l'occurrence on récupère le code html avec une requête effectuée avec l'object xmlhttp
et l'on doit monter ce code dans un document html (virtuel pour l'occasion) avec un DomDocument "htmlfile" en late binding avec createobject
ensuite on récupère les object (table ,TR ou Row), ( TD ou cells),etc...)
Donc ici la requête montée dans une fonction qui retourne le code html l'url en argument
Function GetHtmlcode(URL As String)
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
GetHtmlcode = .responsetext
End If
End With
End Functionensuite une petite sub en exemple qui renvoie les variable A,B,C contenant les 3 valeur Per
Sub test()
Dim URL As String, Codehtml, A, B, C, TR
URL = "https://www.boursorama.com/cours/1rPRMS/"
Codehtml = GetHtmlcode(URL)
With CreateObject("htmlfile")
.body.innerhtml = Codehtml
'on recupere les ligne de la tablehtml 2
If InStr(1, .body.innerhtml, "Estim") = 0 Then MsgBox "requete non aboutie": Exit Sub
Set trs = .getelementsbytagname("table")(2).getelementsbytagname("tr")
'la derniere ligne html de la tablehtml
Set TR = trs(trs.Length - 1)
'les 3 dernieres cellules html de la derniere ligne de la tablehtml(2)
A = TR.Cells(1).innertext
B = TR.Cells(2).innertext
C = TR.Cells(3).innertext
MsgBox A & vbCrLf & B & vbCrLf & C
End With
End Subon a ainsi une bonne façon de travailler des éléments HTML
quand à la question de la légalité il se trouve que afficher la page web dans un navigateur selon les lois en vigueur textuellement serait déjà une infraction
c'est pour cela que beaucoup de site se tournent vers les app php et autres kookies afin de restreindre les possibilités de grabber
donc si c'est pour ton petit boursicotage personnel on t'en voudra pas
Patrick
Bonjour Patrick,
tout d'abord merci pour la réponse et le temps pris pour les explications.
Pour précision je suis une quiche en VBA , j'ai déjà mis un temps fou à comprendre ma macro actuelle :-) .... sans même la comprendre entièrement.
Voila ce que je comprends de tes explication c'est que je récupère directement les infos sur la page source de bourso sans passer par une page tampon .
Tu récupère les infos de la pages pour les intégrer dans un fichier html temporaire , tu récupère ensuite les infos dans ce fichier temporaire pour les intégrer dans les cellules ( dans ton exemple tu les fait afficher à l'écran via un message box)
Je vais essayer de comprendre tout ca pour l'intégrer maintenant dans mon fichier , ce qui ne va pas être le plus facile :-)
Dans ta fonction , l'URL tu l'écris en dur
Function GetHtmlcode(URL As String)Dans mon script la fonction est une variable qui vient lire les différentes cellules
URL = Cells(i, [www].Column).Value
Une fois l'info récupérée je dois comprendre comment l'intégrer dans la bonne cellule de la bonne colonne , un truc du genre ci-dessous
'les 3 dernieres cellules html de la derniere ligne de la tablehtml(2)
Cells(i, [per2k25].Column).Value = TR.Cells(1).innertext
Cells(i, [per2k24].Column).Value = TR.Cells(2).innertext
Cells(i, [per2k23].Column).Value = TR.Cells(3).innertext
MsgBox A & vbCrLf & B & vbCrLf & C
Merci
Sub test()
Sheets("COTATIONS").Select
Dim i%, k%, URL$, Codehtml, TR, VALOR, valorEUR, diva, divb, divc, bpaa, bpab, bpac, pera, perb, perc, renda, rendb, rendc
k = Cells(Rows.Count, [REF].Column).End(xlUp).Row
On Error Resume Next
For i = 2 To k
DoEvents
ReDim pera(1 To k, 1 To 1)
pera(1, 1) = Cells(i, [per2k23].Column).Value
URL = Cells(i, [www].Column).Value
Codehtml = GetHtmlcode(URL)
On Error Resume Next
With CreateObject("htmlfile")
.body.innerhtml = Codehtml
'on recupere les ligne de la tablehtml 2
If InStr(1, .body.innerhtml, "Estim") = 0 Then MsgBox "requete non aboutie": Exit Sub
Set trs = .getelementsbytagname("table")(2).getelementsbytagname("tr")
'la derniere ligne html de la tablehtml
Set TR = trs(trs.Length - 1)
'les 3 dernieres cellules html de la derniere ligne de la tablehtml(2)
pera = TR.Cells(1).innertext
perb = TR.Cells(2).innertext
perc = TR.Cells(3).innertext
MsgBox pera & vbCrLf & perb & vbCrLf & perc
End With
NextIl prend bien mon URL en variable , et la bonne ligne de la page HTML ,,,, lolll un début déjà :-)
| https://www.boursorama.com/cours/MMM/ |
ensuite il prend bien la deuxième cellule ( donc une autre URL ) mais la il décale le tableau à interroger et au lieu d'interroger le PER il interroge un tableau plus haut
| https://www.boursorama.com/cours/1rPAIR/ |
Je continu de chercher ce que je dois modifier dans ma boucle
un essai avec l'experience faible que j'ai
Merci BsAlv , désolé pour ma question un peu stupide mais je ne vois pas la macro dans vos fichier
Patrick, une fois la HTML mis en page tampon , comment avez vous identifié dans quel cellule du tableau se trouvais la bonne donnée ?
Pardon BsAlv , pour la macro dans le fichier j'ai trouvé . je regarde tout ca
tes valeurs sont dans la derniere ligne de tablehtml (2)
dans cette ligne tu a 4 cellule (Per , valeur1 , valeur2 , valeur3)
mais à ce que je vois tu change de table
et tu essaie le même code c'est p"as bon
le mieux c'est de recupérer les tables sur une page tampon et d'aller chercher ensuite tes données dans la feuille
exemple ici je simule un copier coller de toute les tables html dans la feuille active en prenant soin de récupérer le titre de la table dans 2 parent au dessus
Function GetHtmlcode(URL As String)
On Error Resume Next
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", URL, False
.Send
If .Status = 200 Then
GetHtmlcode = .responsetext
End If
End With
End Function
Sub test()
Dim URL As String, Codehtml, cd$
URL = "https://www.boursorama.com/cours/1rPRMS/"
ActiveSheet.Cells.Clear
Codehtml = GetHtmlcode(URL)
With CreateObject("htmlfile")
.body.innerhtml = Codehtml
'on recupere les ligne de la tablehtml 2
For Each elem In .all
If elem.classname = "c-block " Then
cd = cd & "<Font size=4 ><b>" & elem.ChildNodes(0).innertext & "<b><font>" & vbCrLf
Set tb = elem.getelementsbytagname("Table")
If tb.Length > 0 Then
cd = cd & tb(0).outerhtml & vbCrLf & vbCrLf & vbCrLf
End If
End If
Next
.parentWindow.clipboardData.setData "Text", "<html><body>" & cd & "</body></html>"
Application.ScreenUpdating = False
With ActiveSheet
.Activate
.Cells(1).Select
.Paste
[A1].Select
End With
.parentWindow.clipboardData.clearData "Text"
End With
End Subaprès ça, tu a toute tes tables tu peux récupérer ce que tu veux
Wahou ... je sais pas ce qui me plait le plus , la technique qui est excellente ou ta présentation en video
La tout deviens claire pour moi . Grand merci !!
BsAlv , j'aime ta macro , en fait tu à fais la boucle que je tente de construire depuis tout a l'heure
D'une certaine façon elle est simple , en plus tu l'a bien détaillé par processus )
La seule chose que je ne comprend pas dans ton code c'est la manière dont tu identifie les cellules dans lesquelles tu viens coller tes résultats

