Excel - Json et sa toison ( importation )

Version imprimable

Voir 40 message(s) de cette discussion en une page

26/01/2017, 17h05
fifi5622

bonjour a tous ,

pffff y a tellement de code pour la même chose que je suis perdu :lol:

encore une fois merci a vous pour votre travail

Patrick ton code dans le message # 49 ( fonctionne très bien et très rapide )

mais dans la dernière cellule du tablo excel on trouve "3}]}}" au lieu de 3 :P

je taquine ...vas pas prendre ca mal ...

moi je vais m' arrêter par la pour ce post ,j'ai plus d’élément qu'il ne me faut ( promis je vais voir pour changer mes "Query table ")

je vais sans doute prendre un de vos codes et l’intégrer a mon fichier " mère "
e recuperer les infos que j'ai besoin au coup par coup

merci et a bientot peut etre

Tous rapides chez moi ' le tps de lancer la macro et hop

( mais des fois le site de geny sature meme sous navigateur , peut être y a-t-il un filtre ip ( ban de X min en fonction du trafic ? .... )
ou trafic ralenti pour ip qui demande bpc de ressource .....

je sais pas je spécule ...

ah si une dernière petite question

a quoi sa sert les dim avec les $ % & ( jamais utilisé ça moi )

Citation:

Envoyé par fifi5622

a quoi sa sert les dim avec les $ % & ( jamais utilisé ça moi )

C'est un héritage du grand-père du VBA, le BASIC, pour déclarer les variables.
Jette un œil pendant l'exécution à la fenêtre Variables locales ou encore à l'aide VBA des types de données …

Citation:

Envoyé par fifi5622

moi je vais m' arrêter par la pour ce post

Ce serait ballot de louper l'essentiel : l'accès au json via une structure objet !

Car si VBA ne dispose pas en standard d'une structure objet pour traiter des données au format json
- à l'époque json ne devait pas exister ou n'était pas courant et à quoi bon vu que ce n'est que du texte structuré -
sous Windows il reste ouvert et peut accéder à des fonctionnalités externes comme on l'a vu dans les codes précédents :
accès à des objets ActiveX pour exécuter une requête ou des expressions rationnelles …

Surtout que les données json du lien étant un cas d'école, respectant bien la norme, pas d'incohérence entre les lignes,
ce serait dommage de se priver de l'accès au JScript permettant de lire les données via un modèle objet.
Pour voir sa structure on peut par exemple créer une variable objet sur la racine des données
mais on l'a connait déjà car on l'a visualisée via l'outil d'inspection d'un navigateur !

Les noms des champs des données json devenant des propriétés directement exploitables dans le code,
il suffit juste de respecter la casse (voir les lignes n°12 & 21), c'est bien pratique pour réordonner les informations :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 Sub DemoJSon() Dim oJS As Object, oNautes As Object, R&, Arg As Object Set oJS = CreateObject("ScriptControl") oJS.Language = "JScript" ActiveSheet.UsedRange.Clear With CreateObject("MSXML2.XMLHttp") .Open "GET", "http://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=1004963", False .setRequestHeader "DNT", "1" .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64)" On Error Resume Next .send Set oNautes = oJS.Eval("(" & .responseText & ")").ResultSet.lstChevauxPersonne On Error GoTo 0 End With If oNautes Is Nothing Then Beep: Set oJS = Nothing: Exit Sub [D1:G1].Value = Split("NOM COURSES PLACES VICTOIRES") R = 1 For Each Arg In oNautes R = R + 1 With Arg Cells(R, 4).Resize(, 4).Value = Array(.nomCheval, .courses, .places, .victoires) End With Next Set oJS = Nothing: Set oNautes = Nothing End Sub
On peut même en créer une variante selon les titres des colonnes présentes dans la feuille de calculs,
évitant de créer autant de procédures que de présentations différentes …

Cadeau bonus : une référence cinématographique, voire même biblique ou odyséenne,
en rapport avec le titre de cette discussion est cachée dans ce code !
Tout comme celle cachée dans la première procédure expliquant pourquoi à la romaine …

_________________________________________________________________________________________________________
A force de sacrifier l’essentiel à l’urgent, on oublie l’urgence de l’essentiel. (Edgar Morin)

26/01/2017, 19h03
fifi5622

bon bon tu me prend par la nostalgie .....

Basic ( ca me rappelle un truc ca , lol ) j'ai du me taper des lignes de code dans ma jeunesse de basic '
enfin plus recopier bêtement des listing de codes ( avec des erreurs bien entendu ) listing vendu dans des revus pour " fabriquer" un nouveau jeux ....

mais j'ai du faire également quelques petit prog a moi a l’époque

sur un Amstrad cpc 6128 ( couleur !!!! )
et je crois bien avoir faire côtoyer aussi un to7 :ptdr:

bon donc ok je vais rester jusqu'au final alors ( mais je serai moins présent ( delai plus long ) , j'ai d'autres chat a surveiller )

je vais regarder ce nouveau code ... mais ca va vite pour moi la

Merci pour le kdo bonus ,j'avoue j'avais trouvé bizarre le nom de la macro " a la romaine " (pensais a une méthode d' extradition vba romaine moi mdr )
mais bon c'est décidé je remonte sur le bateau et on va chercher ensemble cette toison ;)

faudrait qu'on trouve un nom a notre groupe de recherche t'aurai pas une idee .... Marc :P

PS : pour info je viens t’intégrer un de vos codes ( je dis pas lequel pour pas faire de jaloux ) a mon code mère et j'extrait dorénavant n'importe quel entraîneur :mouarf:
26/01/2017, 19h29
Marc-L

Citation:

Envoyé par fifi5622

mais bon c'est décidé je remonte sur le bateau et on va chercher ensemble cette toison ;)

faudrait qu'on trouve un nom a notre groupe de recherche t'aurai pas une idee .... Marc :P

Je pense effectivement qu'on aurait bien la même idée !

Citation:

Envoyé par fifi5622

bon donc ok je vais rester jusqu'au final alors

je vais regarder ce nouveau code ...

Mon dernier code est le final, juste y voir la simplicité d'accès aux données, en particulier la ligne n°21 …
26/01/2017, 23h47
patricktoulon

re

Citation:

Envoyé par Marc-L

Ah bon c'est long chez toi ?!
De mon côté c'est instantané, même au démarrage de Windows, pas de différence avec mon Split / Replace du post #20 …

Et fifi5622 ?

hoh!!! la différence est pas énorme 300 millisecondes je le signale simplement car je le trouve assez important quand même pour 118 subjson avec 6 clés

Marc dans un avenir si comme je le crois c'est le même style de boulot que sebphyto tu pourrais lui parler de ta ruche

@fifi5622 ? tu fait ce que tu veux mais par expérience je me suis rendu compte que querytable gèrent très mal les header et vu que de ce coté les site deviennent de plus en plus exigeants forcement ya des ratés
c'est pou cela que je ne l'utilise pas pour le HTML

pour info
j'ai fait le test tout a l'heure (150 requêtes d'affilé et il y a des ratés par contre ci mon header de requête est conforme c'est plein pot
27/01/2017, 16h34
davido84
Bonjour,

juste pour les fanas du RegExp, possibilité d'utiliser un seul motif pour récupérer l'ensemble des données:
Code:

1 2 3 4 5 6 With CreateObject("VBScript.RegExp") .Global = True T = Replace(T, """", "") .Pattern = "(?!.+\[):(.+?)(?:}?,|}])" Set oMatches = .Execute(T) End With
On récupère ainsi un submatches unique qu'il ne reste plus qu'à ventiler.
A déconseiller cependant sur de trop grandes données à traiter (pas testé mais j'ai des doutes...).

Sinon et juste pour info l'objet ScriptControl ne fonctionne pas sous Excel 64 bits.
A+

on peut même ne pas utiliser un replace avant le motif pour nettoyer la chaîne des guillemets et les exclure dans le motif :

Code:

.Pattern = "(?!.+\[):""?(.+?)""?(?:}?,|}])"

A+

Salut David !

Tes masques, c'est du costaud !

Citation:

Envoyé par davido84

A déconseiller cependant sur de trop grandes données à traiter

C'est pour cela je laisse Excel s'en charger via sa fonction de conversion …

Citation:

Envoyé par davido84

On récupère ainsi un submatches unique qu'il ne reste plus qu'à ventiler.
A déconseiller cependant sur de trop grandes données à traiter

Citation:

Envoyé par davido84

on peut même ne pas utiliser un replace avant le motif pour nettoyer la chaîne des guillemets et les exclure dans le motif

De mon côté il est bien plus rapide d'utiliser deux masques, un pour découper en lignes et,
quitte à utiliser des sous-masques, un pour séparer en colonnes :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub DemoRegExp2()
         Dim T$, oRows As Object, VA(), C&, R&
         ActiveSheet.UsedRange.Clear
    With CreateObject("MSXML2.XMLHttp")
        .Open "GET", "http://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=1004963", False
        .setRequestHeader "DNT", "1"
        .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64)"
         On Error Resume Next
        .send
         On Error GoTo 0
        If .Status = 200 Then T = .responseText Else Beep: Exit Sub
    End With
    With CreateObject("VBScript.RegExp")
            .Global = True
           .Pattern = "{[^{}]+}"
        If .Test(T) Then
                Set oRows = .Execute(T)
                 .Pattern = """([^""]+)"":""?([^"",}]+)"
            With .Execute(oRows(0))
                   ReDim VA(1 To oRows.Count + 1, 1 To .Count)
                For C = 1 To .Count
                    With .Item(C - 1)
                         VA(1, C) = .SubMatches(0)
                         VA(2, C) = .SubMatches(1)
                    End With
                Next
            End With
            For R = 3 To UBound(VA)
                With .Execute(oRows(R - 2))
                    For C = 1 To .Count:  VA(R, C) = .Item(C - 1).SubMatches(1):  Next
                End With
            Next
                Set oRows = Nothing
                [A1].Resize(R - 1, C - 1).Value = VA
        End If
    End With
End Sub

30/01/2017, 10h05
patricktoulon

Re

Bonjour a tous
Attention marc tu fait la meme erreur qu avec l object servant a traiter les jsons dans une autre discussion tu cre ton groupe de cle avec le subjson(1)j ai remarqué. Dans certains en ce qui concerne l exemple entraineur gen. Que la cl. ''places''n y etait pas, il y avait seulement la valeur
C es pour cela que seule la virgule constitue un delimiteur sur pour les elements des subjsons
Posté avec smartphonne
30/01/2017, 10h11
Marc-L

La virgule pourtant y est bien sinon ce code ne pourrait déjà pas fonctionner avec le lien en exemple !

C'était aussi en retour pour David … Sinon indique-moi un lien d'un entraîneur posant problème.
30/01/2017, 10h17
patricktoulon

Re

Je vais essayer de le. Retrouver
Ala place de
,'' places'':1,
Il y avait
, ''1''

C est la derniere cle normalement

Posté. Avec smartphone
30/01/2017, 10h18
Marc-L

Je viens de comprendre, si tu me trouves un lien … C'est le problème quand la norme n'est pas respectée !

je le retrouve pas mais j'avais gardé mon model pour récupérer tout les json concernant les entraineurs qui participe a n'importe quelle course du jour toute réunions confondues

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Function codehtmlpage(url)
    Set Req = CreateObject("microsoft.xmlhttp")
    With Req
        .Open "GET", url, False
        .SetRequestHeader "Accept", "text/html, application/xhtml+xml, */*"
        .SetRequestHeader "Accept-Language", "fr-FR"
        .SetRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; Trident/7.0; rv:11.0) like Gecko"
        .SetRequestHeader "Accept-Encoding", "gzip, deflate"
        .SetRequestHeader "Host", "www.geny.com"
        .SetRequestHeader "Connection", "Keep - Alive"
        .SetRequestHeader "Cache-Control", "no-cache"
        .send
        codehtmlpage = .responsetext
        'Debug.Print .responsetext
    End With
End Function

' je récupère toutes les courses d'aujourd'hui

Code:

1
2
3
4
5
6
7
8
9
10
Sub recupecourse()
    url = "http://www.geny.com/reunions-courses-pmu"
    With CreateObject("htmlfile")
        .write codehtmlpage(url)
        Set mesa = .getelementsbytagname("a")
        For i = 0 To mesa.Length - 1
            If mesa(i).classname = " btnCourse" Then a = a + 1: Cells(a, 1) = Replace(mesa(i).href, "about:/", "http://www.geny.com/")
        Next
    End With
End Sub

je récupère les IDs entraineurs

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub recupentraineur()
    For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
        With CreateObject("htmlfile")
            .write codehtmlpage(Cells(i, 1).Value)
            Set mesa = .getelementsbytagname("a")
            a = 1
            For c = 0 To mesa.Length - 1
                t = mesa(c).href
                If t Like "*_e*" Then a = a + 1: Cells(i, a) = Split(t, "_e")(1)
                '"https://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=" &identraineur & "&type_onglet=chevaux&type=json"
                t = ""
            Next
        End With
    Next
End Sub

je recupere un json

Code:

1
2
3
4
Sub recupejson()
textejson = codehtmlpage("https://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=" & Cells(1, 2).Value & "&type_onglet=chevaux&type=json")
 Debug.Print textejson
End Sub

je regarderais ce soir en rentrant pour le moment miammiam et boulot

1 pièce(s) jointe(s)

bonjour a tous

me revoilà

depuis le début de la semaine je cherche a adapter un des nombreux code que vous m'avez fourni , dans mon fichier mais a chaque fois cela "merdouille "
au passage j'ai choisi un autre onglet de la page source

donc je reviens vers vous :oops:

cela merdouille quand je souhaite utiliser le tableau , pour pouvoir extraire une donnee

j'ai essayer avec "DemoRegExp" et les autres macro Egalement

1 ) je cherche le lien qui va bien et je lance la macro , ok ca fonctionne

http://www.hostingpics.net/viewer.php?id=136347etrange.jpg

2 ) je cherche le lien qui va bien et je lance la macro puis je lance une recherche pour extraire les donnees , :aie::roll::calim2: plus rien fonctionne

http://www.hostingpics.net/viewer.php?id=630028etrange2.jpg

dans le second cas on voit que les données json reste brut alors que mon code de recherche ne se lance que apres ( ou meme si je l'appelle via un autre module j'ai le meme resultats .... etrange etrange ....

bon je viens de vous refaire un petit fichier excel ( cette fois avec la macro "argonautes" ) et la je sais pas trop ou j'ai merdouille mais le tableau ne s'affiche pas donc je ne peux pas aller plus loin

en feuil 1 " les donnees que j'exploite " , en feuil2 je veux afficher le tableau ( json ) , et en feuille 3 je voudrais afficher la correspondance des donnnes et du tableau json

en commentaire
la version d'origine
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 Sub DemoJSon() ' (lien As String,ide as string)l y a une boucle sur chaque traineur de la course ide est donc le numero id de lentraineur1 , puis on passe on second et au troisieme ect... Dim oJS As Object, oNautes As Object, R&, Arg As Object Set oJS = CreateObject("ScriptControl") oJS.Language = "JScript" Sheets("Feuil2").Select ActiveSheet.UsedRange.Clear ''''''''''''' modif lien2 = Sheets("Feuil1").[N10] ' info qui est dispo sur la feuil1 'MsgBox lien2 ' lien2 = "1004963" lien3 = "https://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=1007895&type_onglet=jockeys&type=json" ' lien3 = "www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=" & lien2 & "&type_onglet=jockeys&type=json" With CreateObject("MSXML2.XMLHttp") .Open "GET", "http://" & lien3, False ' .Open "GET", "http://www.geny.com/flux-donnees-fiche-entraineur?id_entraineur=1004963", False .setRequestHeader "DNT", "1" .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64)" On Error Resume Next .send 'Set oNautes = oJS.Eval("(" & .responseText & ")").ResultSet.lstChevauxPersonne Set oNautes = oJS.Eval("(" & .responseText & ")").ResultSet.lstJockeys On Error GoTo 0 End With If oNautes Is Nothing Then Beep: Set oJS = Nothing: Exit Sub ' [E1:I1].Value = Split("NOM idCheval COURSES PLACES VICTOIRES") [E1:I1].Value = Split("NOM idJockey COURSES reussiteVictoires reussitePlaces") R = 1 For Each Arg In oNautes R = R + 1 With Arg ' Cells(R, 5).Resize(, 5).Value = Array(.nomCheval, .idCheval, .courses, .places, .victoires) Cells(R, 5).Resize(, 5).Value = Array(.Nom, .idJockey, .courses, .reussiteVictoires, .reussitePlaces) End With Next Set oJS = Nothing: Set oNautes = Nothing ' Call cherchetrouve'(ide) End Sub Sub cherchetrouve() '(ide) Dim ide '( ide = id de l'entraineur il est deja defini avant pas de souci de ce cote ) 'je cherche le ou les jockey qui sont associees a l'entraineur tableau qui devrais s'afficher sur la feuil2 'et je souhaite ensuite trouver le nombre de victoire du jockey et j'affiche le resultats 'en feuil3 C2 '.Find(what:=ide , LookIn:=xlValues, lookat:=xlWhole) End Sub

10/02/2017, 15h48
Marc-L

Quant une requête ne fonctionne pas, le premier réflexe est de contrôler ce que renvoie .responseText,
par exemple via un Debug.Print …

Edit : si c'est bon alors erreur dans les propriétés : soit une fôte d'ortograf :aie: soit carrément une propriété n'existant pas !

Et c'est pourtant si simple à vérifier en comparant les propriétés de la ligne de code n°50 et la source :

Cells(R, 5).Resize(, 5).Value = Array(.Nom, .idJockey, .courses, .reussiteVictoires, .reussitePlaces) …
10/02/2017, 19h23
fifi5622

oui je me suis rendu compte de ma boulette ce matin juste avant de partir au taf :oops:
mais pour ca je suis reparti de ton code original et j'ai modifier ligne par ligne et fais des essais

Code:

Cells(R, 5).Resize(, 5).Value = Array(.jockey, .idJockey, .reussiteVictoires,

"debugprint" je vais regarder comment cela fonctionne ça pourrais encore me servir

par contre pour la seconde parti de mon souci , il faut que je réfléchisse déjà sur comment procéder .....
10/02/2017, 20h02
fifi5622

bon bon
j'ai une nouvelle question

comment extraire le lien hypertexte de la cellule de gauche ?

j'extrait le lien hypertexte de ma cellule active , et je souhaite aussi récupère le lien hypertexte de ma cellule voisine qui est a gauche

a= Right(.Hyperlinks(1).Address, 7) ' la j'extrait les 7 derniers caracteres du lien hypertexte

a=.Offset(, -1) la je vais sur la cellule de gauche

a = .Offset(, -1).Right(.Hyperlinks(1).Address, 7) ' ca marche pas et je trouve pas trop sur le net

ou alors en 2 temps ? je suis sur ma cellule active je récupère mon 1 r lien hypertexte ,
je me déplace j'active la nouvelle cellule et je récupère le lien hypertexte de la nouvelle cellule et je passe a autre chose ?
10/02/2017, 22h18
fifi5622

bon non sans mal

j'ai reussi en etapes

a = Cel.Offset(, -1).Hyperlinks(1).Address
a = Split(a, "_j")(1)

:mrgreen:
10/02/2017, 23h08
fifi5622

a = Right(Cel.Offset(, -1).Hyperlinks(1).Address, 7) :ptdr:
11/02/2017, 11h41
fifi5622

après plusieurs essai , j'ai enfin réussi a l’intégrer le code a mon fichier tropppp coollllll :mrgreen:

le souci étais je réutilisais via une autre macro la feuil en question et donc les données n’étais plus present au moment ou je voulais les extraires !!!!

je vais pouvoir essayer 'd' optimiser mon code et changer quleques " QueryTables"

Voir 40 message(s) de cette discussion en une page