Récupération Json PMU

Bonjour,

J'aimerai récupérer via un fichier Json ce tableau ci-dessous :

Cette programmation devient un peu complet pour moi, j'aurai besoin de votre aide.

Voici le lien et la structure du Json dans le fichier suivant :

Merci pour votre aide.

Au plaisir de vous lire

Patron28

Bonjour,

Sub decrypter()

    Sheets("direct").Range("A1").CurrentRegion.Offset(1, 1).Clear
    Sheets("reference").Range("A1").CurrentRegion.Offset(1, 1).Clear

        DoEvents
        URL = Sheets("url").Range("A1")
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .Send
            If .Status = 200 Then
                donnee = .responsetext

                tbl = Split(donnee, "[")
                For n = 2 To UBound(tbl) - 1
                    couple = Split(tbl(n), "]")(0)
                    i = Split(couple, ",")(0) * 1
                    j = Split(couple, ",")(1) * 1
                    r = Replace(Split(Split(tbl(n), """rapportReference"":")(1), ",")(0), ".", ",") * 1
                    d = Replace(Split(Split(tbl(n), """rapportDirect"":")(1), ",")(0), ".", ",") * 1
                    Sheets("direct").Cells(i + 1, j + 1).Value = d
                    Sheets("reference").Cells(i + 1, j + 1).Value = r
                Next

            End If
        End With

End Sub

Merci Steelson pour la réponse rapide.

Je vais voir ton fichier et je reviens vers toi.

Patron28

Bonjour,

Le programme fonctionne très bien.Merci Steelson.

J'aimerai l'utiliser pour toutes les courses et toutes les dates. par exemple sur la première page avoir comme ce tableau ci-dessous

Je change la date,la réunion et la course et je lance la récupération.

Pour faire cela je dois changer l'URL dans ta macro ? ou faire autre chose?

Merci pour la réponse.

Patron28

Sub decrypter()

    Sheets("direct").UsedRange.Offset(1, 1).Clear
    Sheets("reference").UsedRange.Offset(1, 1).Clear

        DoEvents
        URL = Sheets("url").Range("www")
        On Error Resume Next
        With CreateObject("MSXML2.XMLHTTP")
            .Open "GET", URL, False
            .Send
            If .Status = 200 Then
                donnee = .responsetext
                tbl = Split(donnee, "[")
                For n = 2 To UBound(tbl) - 1
                    couple = Split(tbl(n), "]")(0)
                    i = Split(couple, ",")(0) * 1
                    j = Split(couple, ",")(1) * 1
                    r = Replace(Split(Split(tbl(n), """rapportReference"":")(1), ",")(0), ".", ",") * 1
                    d = Replace(Split(Split(tbl(n), """rapportDirect"":")(1), ",")(0), ".", ",") * 1
                    Sheets("direct").Cells(i + 1, j + 1).Value = d
                    Sheets("reference").Cells(i + 1, j + 1).Value = r
                Next

            End If
        End With

End Sub

Merci Steelson, cela fonctionne super.

Patron28