Former un tableau venant d'une requête

Le 15/01/2020 à 14:27

Je n'ai pas trouvé mieux ! tout est automatique et il suffit ensuite de puiser dans le résultat ! Et ce qui me rassure, c'est que l'outil ci-dessus ne comprend pas mieux un "json gigogne" aussi logique soit-il.

J'ai juste épuré pour qu'il prenne n'importe quelle sortie.

Il faut juste changer la requête html pour s'adapter au site.

Option Explicit
Public ScriptEngine As Object
Public ScriptEnginePrototype As Object
Dim iData%

Public Sub decrypterJSON()
Dim JsonString As String, txt As String, j As Long
Dim http As Object
Dim JsonObject As Object, data As Object, Elem As Object, i%
Dim URL As String

' raz
    Sheets("data").[A1].CurrentRegion.Offset(1, 0).ClearContents
    iData = 2

' origine des informations
    URL = Sheets("data").Range("URL").Value
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.send
    txt = http.responseText

' avec traitement spécifique ici pour éviter le json gigogne
    JsonString = ""
    For j = 1 To Len(txt)
        If Mid(txt, j, 1) <> "\" Then JsonString = JsonString & Mid(txt, j, 1)
    Next
    JsonString = Replace(JsonString, vbCrLf, "")
    JsonString = Replace(JsonString, vbTab, "")
    JsonString = Replace(JsonString, "report"":""", "report"":")
    JsonString = Replace(JsonString, "}}}""}", "}}}}")

' decodage
    InitScriptEngine True
    Set JsonObject = ScriptEngine.Eval("(" + CStr(JsonString) + ")")
    Set data = ScriptEnginePrototype.Eval("(" + CStr(JsonString) + ")")
    routineJSON JsonObject, 1

End Sub

Public Sub InitScriptEngine(ok As Boolean)

    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "

    Set ScriptEnginePrototype = CreateObject("ScriptControl")
    ScriptEnginePrototype.Language = "JScript"
    ScriptEnginePrototype.AddCode "Object.prototype.item=function( i ) { return this[i] } ; "

End Sub

Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function

Public Sub routineJSON(JsonObject As Object, niveau As Integer, Optional parent As String = "data")
    Dim Keys() As String
    Dim ceci As Variant
    Dim SousObject As Object
    Dim i As Variant

    Keys = GetKeys(JsonObject)

    For i = LBound(Keys) To UBound(Keys)
        ceci = GetProperty(JsonObject, Keys(i))
        On Error Resume Next ' teste le cas d'un objet et détermine si non en cas d'erreur !
        Set SousObject = GetObjectProperty(JsonObject, Keys(i))

        If Err.Number Then ' c'est une valeur
            sortieData Keys(i), niveau, ceci, parent & "." & Keys(i)

        Else ' c'est un objet
            parent = parent & "." & IIf(GetProperty(JsonObject, "length") = "", Keys(i), "item(" & Keys(i) & ")")
            sortieData Keys(i), niveau, "[ " & IIf(GetProperty(JsonObject, "length") = "", "parent", "array") & " ]", parent
            niveau = niveau + 1

                ' appel récursif
                routineJSON SousObject, niveau, parent

            parent = Left(parent, Len(parent) - InStr(StrReverse(parent), ".")): niveau = niveau - 1
        End If
    Next

End Sub

Sub sortieData(cle As Variant, niv As Integer, valeur As Variant, acces As String)
    With Sheets("data")
        .Cells(iData, 1) = niv
        .Cells(iData, niv + 1) = acces
        .Cells(iData, niv + 2) = cle
        .Cells(iData, niv + 3) = valeur
        iData = iData + 1
    End With
End Sub

Nota : ce code n'est pas entièrement de mon cru, mais je n'ai pas retrouvé le principal contributeur des fonctions Getmachin. Il s'agit d'une adaptation.

8shenzar-json.xlsm (72.43 Ko)

7shenzar-json-original.zip (8.89 Ko)

Le 15/01/2020 à 20:15

Ton travail et super, je le teste sur le site intranet et voir son comportement

Je peux rajouter le code request = request entre :

Je suis en week end, je vais regarde ça de plus prés et me documenter, et il est vrai que ce caractère \ bloque beaucoup de chose

C'est que du replace et du split etc je comprends mieux le travail du jsonconverter, à long terme powerquery va le remplacer parce que J'ai copier coller le json de base sans requete sur excel et regarde du coté de power query pour essayer comprendre voila ce que j'en ai ressorti :

Le défaut c'est qu'on peut pas faire de requete en cochant les cases sur powerquery l'affichage du site et figer, dommage ou alors j'ai loupé un truc

Je test ton fichier et te fais un retour et me documente un peu plus sur les sites anglais ton lien est pas mal

Le 16/01/2020 à 02:33

Je doute que PowerQuery sache traiter les \ car ici il s'agit d'une structure très particulière où un json est contenu dans une donnée à l'intérieur d'un json chapeau.

Ici une vidéo sur PowerQuery et le traitement d'un json lambda.

https://www.youtube.com/watch?v=-OmcausnWdM&feature=youtu.be

De mon côté, je vais travailler sur la transformation d'un json en base de données, e qui permettra ensuite via un TCD d'obtenir un tableau re-configurable à souhait.

Le 16/01/2020 à 16:36

Je vais regardé la video

Que pense-tu d'un modèle comme celui-ci

Je peux pas le tester pour le moment je suis pas au taffe pour voir son comportement ou les erreurs qu'il va afficher

l'erreur que je faisais par rapport à ce que tu as fais c'est de coller la réponse dans le sheet, j'ai eu des coupures par moment dû à la limite de caractère

J'ai pas réfléchis que le fichier communique avec le serveur qui renvoie le data (reponse) et que je pouvais selectionner la réponse que je désirais

ensuite la mettre en forme par la conversion en vba

J'ai rajouté une variable dict as dictionnary pour le jsonconverter, j'ai aussi fais un deuxieme fichier avec ton code ton code qui est plus d'actualité, comme c'est un site intranet je dois attendre lundi pour tester les réponses, je profite de ce temps pour me documenter et me monter un site en local

Je regarde ta video

Ce site à l'air pas mal pour apprendre :

J'ai trouvé ça aussi :

Le 17/01/2020 à 01:42

En fait je ne travaille pas avec jsonconverter, je me suis créé ma propre routine à partir de codes plus concis ... et je peux encore simplifier :

Option Explicit
Public ScriptEngine As Object
Dim iData%

Public Sub decrypterJSON()
Dim JsonString As String, txt As String, j As Long
Dim http As Object
Dim JsonObject As Object, data As Object, Elem As Object, i%
Dim URL As String

' raz
    Sheets("data").[A1].CurrentRegion.Offset(1, 0).ClearContents
    iData = 2

' origine des informations
    URL = Sheets("data").Range("URL").Value
    Set http = CreateObject("MSXML2.XMLHTTP")
    http.Open "GET", URL, False
    http.send
    txt = http.responseText

' avec traitement spécifique ici pour éviter le json gigogne
    JsonString = ""
    For j = 1 To Len(txt)
        If Mid(txt, j, 1) <> "\" Then JsonString = JsonString & Mid(txt, j, 1)
    Next
    JsonString = Replace(JsonString, vbCrLf, "")
    JsonString = Replace(JsonString, vbTab, "")
    JsonString = Replace(JsonString, "report"":""", "report"":")
    JsonString = Replace(JsonString, "}}}""}", "}}}}")

' decodage
    InitScriptEngine True
    Set JsonObject = ScriptEngine.Eval("(" + CStr(JsonString) + ")")
    routineJSON JsonObject, 1

End Sub

Public Sub InitScriptEngine(ok As Boolean)
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub

Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function

Public Sub routineJSON(JsonObject As Object, niveau As Integer)
    Dim Keys() As String
    Dim ceci As Variant
    Dim SousObject As Object
    Dim i As Variant

    Keys = GetKeys(JsonObject)

    For i = LBound(Keys) To UBound(Keys)
        ceci = GetProperty(JsonObject, Keys(i))
        On Error Resume Next ' teste le cas d'un objet et détermine si non en cas d'erreur !
        Set SousObject = GetObjectProperty(JsonObject, Keys(i))
        If Err.Number Then ' c'est une valeur
            sortieData Keys(i), niveau, ceci
        Else ' c'est un objet
            sortieData Keys(i), niveau, ""
            niveau = niveau + 1
            routineJSON SousObject, niveau
            niveau = niveau - 1
        End If
    Next

End Sub

Sub sortieData(cle As Variant, niv As Integer, valeur As Variant)
    With Sheets("data")
        .Cells(iData, niv) = cle
        .Cells(iData, niv + 1) = valeur
        iData = iData + 1
    End With
End Sub

Le 20/01/2020 à 08:01

Salut a toi Steelson

J'ai ressayer ton code ce matin avec ça :

Option Explicit
Public ScriptEngine As Object
Dim iData%

Public Sub decrypterj()
Dim JsonString As String, txt As String, j As Long
Dim http As Object
Dim JsonObject As Object, data As Object, Elem As Object, i%
Dim URL As String, request As String

' raz
    Sheets("data").[A1].CurrentRegion.Offset(1, 0).ClearContents
    iData = 2

' origine des informations
    URL = Sheets("data").Range("URL").Value
    Set http = CreateObject("MSXML2.XMLHTTP")

    request = "warehouseId=ORY1&stowmapRequestParams={""floorModMapSelection"":{""areaSelection"":{""1"":{""P-1-E"":{""EAST-HAZMAT"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true},""EAST-1E"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-1-V"":{""hv1"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-1-A"":{""WEST-1A"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""WEST-RACK"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true},""WEST-RACK-A"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-1-B"":{""WEST-1B"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true},""WEST-1B500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-1-Z"":{""pa-unknown"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-1-D"":{""EAST-1D500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""EAST-1D"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}}},""2"":{""P-2-D"":{""EAST-2D500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""EAST-2D"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-2-E"":{""EAST-2E"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-2-A"":{""WEST-2A"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-2-B"":{""WEST-2B"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""WEST-2B500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}}},""3"":{""P-3-D"":{""EAST-3D500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""EAST-3D"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-3-E"":{""EAST-3E"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-3-A"":{""WEST-3A"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-3-B"":{""WEST-3B"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""WEST-3B500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}}},""4"":{""P-4-B"":{""WEST-4B"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""WEST-4B500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-4-D"":{""EAST-4D500"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true},""EAST-4D"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}},""P-4-E"":{""EAST-4E"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":true}},""P-4-A"":{""WEST-4A"":{""aisleRanges"":[{""minAisle"":0,""maxAisle"":0}],""areAllAislesSelected"":"
    request = request & "true}}}}},""binsSelection"":{""binTypes"":[""DRAWER"",""LIBRARY_DEEP_DRAWER"",""LIBRARY_DRAWER""],""binUsages"":"
    request = request & "[""DAMAGE"",""DIRECTED_MULTI_ASIN"",""DIRECTED_MULT_ASIN"",""OLD_STYLE_RESERVE"",""PRIME"",""PRIME_PUTBACK"",""PROBLEM_SOLVING"",""RANDOM_DIRECTED"",""RANDOM_STOW"",""RESERVE""],""binProperties"":"
    request = request & "{""IsLocked"":""Ignore"",""CanHoldHighValueAsin"":""Ignore""}},""aggregation Level"":""DropZone"",""shelves"":"
    request = request & "[""A"",""B"",""C"",""D"",""E"",""F"",""G"",""H"",""I"",""J"",""K"",""L"",""M"",""N"",""O"",""P"",""Q"",""R"",""S"",""T"",""U"",""V"",""W"",""X"",""Y"",""Z""],""stowMapAreaSelectionMap"":"
    request = request & "{""1_P-1-E_AllPickAreasSelected"":true,""1_P-1-V_AllPickAreasSelected"":true,""1_P-1-A_AllPickAreasSelected"":true,""1_P-1-B_AllPickAreasSelected"":true,""1_P-1-Z_AllPickAreasSelected"":"
    request = request & "true,""1_P-1-D_AllPickAreasSelected"":true,""1_AllModsSelected"":true,""2_P-2-D_AllPickAreasSelected"":true,""2_P-2-E_AllPickAreasSelected"":true,""2_P-2-A_AllPickAreasSelected"":"
    request = request & "true,""2_P-2-B_AllPickAreasSelected"":true,""2_AllModsSelected"":true,""3_P-3-D_AllPickAreasSelected"":true,""3_P-3-E_AllPickAreasSelected"":true,""3_P-3-A_AllPickAreasSelected"":"
    request = request & "true,""3_P-3-B_AllPickAreasSelected"":true,""3_AllModsSelected"":true,""4_P-4-B_AllPickAreasSelected"":true,""4_P-4-D_AllPickAreasSelected"":true,""4_P-4-E_AllPickAreasSelected"":"
    request = request & "true,""4_P-4-A_AllPickAreasSelected"":true,""4_AllModsSelected"":true,""AllFloorsSelected"":true}}"

    http.Open "GET", URL, False
    http.send request
    txt = http.responseText

' avec traitement spécifique ici pour éviter le json gigogne
    JsonString = ""
    For j = 1 To Len(txt)
        If Mid(txt, j, 1) <> "\" Then JsonString = JsonString & Mid(txt, j, 1)
    Next
    JsonString = Replace(JsonString, vbCrLf, "")
    JsonString = Replace(JsonString, vbTab, "")
    JsonString = Replace(JsonString, "report"":""", "report"":")
    JsonString = Replace(JsonString, "}}}""}", "}}}}")

' decodage
    InitScriptEngine True
    Set JsonObject = ScriptEngine.Eval("(" + CStr(JsonString) + ")")
    routineJSON JsonObject, 1

End Sub

Public Sub InitScriptEngine(ok As Boolean)
    Set ScriptEngine = CreateObject("ScriptControl")
    ScriptEngine.Language = "JScript"
    ScriptEngine.AddCode "function getProperty(jsonObj, propertyName) { return jsonObj[propertyName]; } "
    ScriptEngine.AddCode "function getKeys(jsonObj) { var keys = new Array(); for (var i in jsonObj) { keys.push(i); } return keys; } "
End Sub

Public Function GetProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Variant
    GetProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetObjectProperty(ByVal JsonObject As Object, ByVal PropertyName As String) As Object
    Set GetObjectProperty = ScriptEngine.Run("getProperty", JsonObject, PropertyName)
End Function

Public Function GetKeys(ByVal JsonObject As Object) As String()
    Dim Length As Integer
    Dim KeysArray() As String
    Dim KeysObject As Object
    Dim Index As Integer
    Dim Key As Variant

    Set KeysObject = ScriptEngine.Run("getKeys", JsonObject)
    Length = GetProperty(KeysObject, "length")
    ReDim KeysArray(Length - 1)
    Index = 0
    For Each Key In KeysObject
        KeysArray(Index) = Key
        Index = Index + 1
    Next
    GetKeys = KeysArray
End Function

Public Sub routineJSON(JsonObject As Object, niveau As Integer)
    Dim Keys() As String
    Dim ceci As Variant
    Dim SousObject As Object
    Dim i As Variant

    Keys = GetKeys(JsonObject)

    For i = LBound(Keys) To UBound(Keys)
        ceci = GetProperty(JsonObject, Keys(i))
        On Error Resume Next ' teste le cas d'un objet et détermine si non en cas d'erreur !
        Set SousObject = GetObjectProperty(JsonObject, Keys(i))
        If Err.Number Then ' c'est une valeur
            sortieData Keys(i), niveau, ceci
        Else ' c'est un objet
            sortieData Keys(i), niveau, ""
            niveau = niveau + 1
            routineJSON SousObject, niveau
            niveau = niveau - 1
        End If
    Next

End Sub

Sub sortieData(cle As Variant, niv As Integer, valeur As Variant)
    With Sheets("data")
        .Cells(iData, niv) = cle
        .Cells(iData, niv + 1) = valeur
        iData = iData + 1
    End With
End Sub

sa a donné ça :

On dirai qu'un truc m'échappe

le fichier avec jsonconverter marche bien mais affiche que sur une ligne toujours, un truc m'échappe encore je crois

Merci pour ton aide si tu pouvais m'éclairer, je crois que sur ton code c'est ma requete et pas top

Le 20/01/2020 à 08:59

J'ai retester avec le jsonconverter en modifiant des trucs et j'ai testé la binutilization et sa a marcher j'ai pas encore tester pour chaque colonne

Je crois que sur ton code c'est ma requete qui va pas

Le 20/01/2020 à 09:27

Bonjour

Cela fonctionne à condition de s'en tenir au json seul (comme pour un site internet qui ne transmettrait que le json)

edit = erreur de ma part ... je n'ai testé que le json de la requête !! pour après requête je ne peux pas dire car je n'ai pas accès au site, à moins de me donner la .responstext

3shenzar-json-v4.xlsm (35.07 Ko)

Le 20/01/2020 à 09:57

Je viens de me rendre compte sur mon fichier a moi il m'a copier al réponse sur une colonne mais la même réponse a chaque fois lol

Ce fichier de réponse devrait t'éclairer

13shenzar-requete.zip (12.17 Ko)

Le 20/01/2020 à 10:19

Toujours la même formule de json encadrant un autre json

Après traitement pour enlever les \ et intégrer les 2 parties

' avec traitement spécifique ici pour éviter le json gigogne
    JsonString = ""
    For j = 1 To Len(txt)
        If Mid(txt, j, 1) <> "\" Then JsonString = JsonString & Mid(txt, j, 1)
    Next
    JsonString = Replace(JsonString, vbCrLf, "")
    JsonString = Replace(JsonString, vbTab, "")
    JsonString = Replace(JsonString, "stowMapReport"":""", "stowMapreport"":")
    JsonString = Replace(JsonString, "}}}""}", "}}}}")

cela donne ceci

edit : fichier supprimé au profit du suivant

Le 20/01/2020 à 10:26

Je récupère donc ici toutes les données

3shenzar-json-v5.xlsm (89.16 Ko)

Le 20/01/2020 à 11:10

ton tableau et super propre par rapport à mes bidouillages

Le souci que j'ai c'est que dans mon doc il veut pas se mettre en tableau alors que j'ai bien la réponse

Dans ton doc il veut pas copier la réponse ni la coller

Pourtant sa marche bien dans le sens .send .... et retour de réponse attendu non ?

. send request :

reponse :

Je pense que mon niveau et pas encore au top, va falloir quelques cours encore

Le 20/01/2020 à 12:37

Dans ce cas, j'ai un peu changé le fichier ...

En D2, mets la donnée qui contient le "sous-json", ici stowMapReport

on le voit sur la copie d'écran ci-avant https://forum.excel-pratique.com/viewtopic.php?p=830109#p830109

La réponse est alors découpée pour ne retenir que le cœur du json

' avec traitement spécifique ici pour éviter le json gigogne
    JsonString = ""
    txt = Split(Split(txt, Sheets("data").Range("motcle").Value & """:""")(1), "}}}""}")(0) & "}}}"
    For j = 1 To Len(txt)
        If Mid(txt, j, 1) <> "\" Then JsonString = JsonString & Mid(txt, j, 1)
    Next

Dans l'onglet clé, copie en ligne 1 à partir de la colonne B en transposant les items attendus (regarde l'exemple et compare les 2 onglets)

10shenzar-json-v6.xlsm (88.15 Ko)

Le 26/01/2020 à 01:28

Bonjour steelson,

Faut que je test ton fichier pour ce qui est de la requête, car je dois lui injecter une requete pour dire je veux ça et tu m'envoie la reponse, sa fait plusieurs jours que je test des programmations je suis pas encore a l'aise avec sa, et l'éditeur vba me rends fou, on est loin de vscode ou sublimetexte.

Ton code serait parfait qui génère automatiquement le tableau et les lignes.

Dans le même temps je me suis plancher jsonconverter pour le comprendre j'en suis arriver à ce résultat, mais je suis pas convaincu car je dois balancer 108 lignes, a long terme sa va être une usine à gaz ce truc, mais j'ai pigé le truc au moins, reste à voir la réponse selon la requete que je serai au taffe

Je test tout ça au fut et a mesure de mon avancer

Rechercher des sujets similaires à "former tableau venant requete"