XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur

Rabeto · 28 Juillet 2024

Bonjour à tous,

J'aimerai svp trouver un solution pour améliorer ce code pour trouver tout les valeurs avec une seule ligne de commande, au lieu de répéter la ligne :
.Cells(i + 3, 8).Value = Split(Split(tbl1(i), "Donneé"":")(1), ",")(0)
.Cells(i + 4, 8).Value = Split(Split(tbl1(i), "Donneé"":")(2), ",")(0) Changer 3 par 4 pour mettre les données à la 5e ligne et changer (2) pour avoir la valeur
.Cells(i + 5, 8).Value = Split(Split(tbl1(i), "Donneé"":")(3), ",")(0) pour trouver la troisième valeur et ainsi de suite, je peux aller jusqu'à 1000

Merci d'avance,

Ci-dessous le code au complet
------------------------------------

VB:

Sub Trouver ()
On Error Resume Next

Site = Range("A1").Value
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.Send
donnee = .responsetext
End With
tbl1 = Split(donnee, "date"":")
For i = 1 To UBound(tbl1)
With ActiveSheet

.Cells(i + 3, 8).Value = Split(Split(tbl1(i), "Donneé"":")(1), ",")(0)

End With
Next

MsgBox "Complet"

End Sub

Aya_flo · 3 Août 2024

Bonjour,

Pas besoin de mettre i+x, la boucle va automatiquement passer tous les nombres possibles entre 1 et UBound(tbl1). SI vous souhaitez que i commence à partir de 4, mettre 4 dans le "For". Par contre cela fonctionne avec "next i" et pas uniquement "next".
Concernant la valeur qui évolue de l'autre coté du signe égale (1, 2, 3), je ferais une manipulation avec l'évolution de i pour qu'ils soient évolutifs en même temps. Exemple i-3 si on admet que la valeur doit être 1 quand i = 4.

Cela donnerait le code suivant :

VB:

Sub Trouver ()
On Error Resume Next

Site = Range("A1").Value
With CreateObject("MSXML2.XMLHTTP")
.Open "GET", Site, False
.Send
donnee = .responsetext
End With
tbl1 = Split(donnee, "date"":")
For i = 4 To UBound(tbl1)
With ActiveSheet

.Cells(i , 8).Value = Split(Split(tbl1(i), "Donneé"":")(i-3), ",")(0)

End With
Next i

MsgBox "Complet"[/B][/I]
[B][I]End Sub[/I][/B]
[I][B]

A tester.

XL 2019 Demande à la macro de chercher et de remplir automatiquement jusqu'à la dernière valeur

Rabeto

XLDnaute Occasionnel

Aya_flo

XLDnaute Nouveau

Discussions similaires