comment boucler sur une adresse URL yahoo ???

[albert]

bonjour à tous et à toutes, forumiens, forumiennes…

Je cherche à télécharger un historique couvrant la période allant de 2 janvier 2003 jusqu’au 19 avril 2004
J’obtiens 2 périodes :
1/ du Apr-16-04 au Jul-07-03

http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&g=d&s=ACCP.PA

2/ du Jul-04-03 au Jan-02-03

http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=200&g=d

dans la macro, il y a 2 adresses semblables(bouton feuille 1) :

- du Apr-16-04 au Jul-07-03 où ACCP.PA&y=0

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=0&g=d" _
, Destination:=Range("A1"))
.Name = "d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=0&g=d"

- et du Jul-04-03 au Jan-02-03 où ACCP.PA&y=200

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=200&g=d" _
, Destination:=Range("A218"))
.Name = "d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=200&g=d"

----------
je suppose donc qu’il est possible de boucler sur y= 1 To 200
dans ce cas le téléchargement s’effectue 200 fois…
Je réduis la boucle y= 1 To 2 on a 2 téléchargements, mas seul le 1er apparaît : Apr-16-04 au Jul-07-03 (bouton feuille 2)

J’ai essayé u = Range("A1").End(xlDown).Offset(1, 0).Address pour Destination:=Range(u))
Dans ce cas la page reste vide
----------

Quelqu’un aurait une idée pour obtenir le deux séries à la suite l’une de l’autre ??
Merci d’avance

pièce jointe TelechargeBoucle.zip

albert

 

[albert]

Eurêka!!!
j'ai trouvé...

en fait il n'est pas nécessaire de faire une boucle, il suffit d'ajouter les téléchargements : y=0&200

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=0&200&g=d" _
, Destination:=Range("A1"))
.Name = "d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=0&200&g=d"

 

[albert]

fausse alerte, je me suis réjoit trop vite... ça ne marche pas

 

[Zon]

Salut,

Sous XL2003 ceci focntionne sur la même feuille, ta variable i est à mettre entre &

Sub Macro1()
Dim I&
'--------------efface-------------
Cells.Clear
'----------télécharge------------
For I = 0 To 399 Step 200
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=" & I & "&g=d" _
, Destination:=[A65536].End(xlUp)(2))
.Name = "Requete" & I 'à adapter
.Refresh False
End With
Next I
End Sub

Si tu veux mettre tes à jours ensuite With ActiveSheet.QueryTables("Requete0").refresh

A+++

 

[albert]

merci Zon, c'est une merveille ça marche sur XL2000, j'étais sur une fausse piste...

j'ai supprimé les lignes inutiles (u,v).
il faut que je travaille maintenant .Name =
avec With ActiveSheet.QueryTables("Requete0").refresh



Sub Macro1()
Dim I&
'--------------efface-------------
Cells.Clear
'----------télécharge------------
For I = 0 To 399 Step 200
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=" & I & "&g=d" _
, Destination:=[A65536].End(xlUp)(2))
.Name = "" & I 'à adapter
.Refresh False
End With
Next I
u = Cells(14, 1).End(xlDown).Offset(1, 1).Address
v = Cells(14, 1).End(xlDown).Offset(17, 9).Address
Range(u, v).Select
Selection.Delete Shift:=xlUp

End Sub


cordialement
albert

 

[albert]

c'est bizarre, le système qui fontionnait tout à l'heure, ne marche plus à présent

u = Cells(14, 1).End(xlDown).Offset(1, 1).Address
v = Cells(14, 1).End(xlDown).Offset(17, 9).Address
Range(u, v).Select
Selection.Delete Shift:=xlUp

il faut que je trouve autre chose

 

[albert]

j'ai trouvé : il faut effacer avant de supprimer


u = Cells(14, 1).End(xlDown).Offset(1, 1).Address
v = Cells(14, 1).End(xlDown).Offset(17, 9).Address
Range(u, v).Select
Selection.ClearContents
Call fusionne
End Sub
Sub fusionne()
u = Cells(14, 1).End(xlDown).Offset(1, 1).Address
v = Cells(14, 1).End(xlDown).Offset(17, 9).Address
Range(u, v).Select

 

[albert]

en fait l'opération Selection.Delete Shift:=xlUp est très instable et provoque des erreurs
je la supprime et la remplace par :

v = Cells(14, 1).End(xlDown).Offset(17, 1).Address
Range(v).Select
Selection.EntireRow.Delete
On Error Resume Next
Range("H13:H" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete


les tests sont bons, je garde la solution

Sub Macro1()
Dim I&
'--------------efface-------------
Cells.Clear
'----------télécharge------------
For I = 0 To 399 Step 200
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://chart.yahoo.com/d?a=0&b=1&c=2003&d=3&e=18&f=2004&s=ACCP.PA&y=" & I & "&g=d" _
, Destination:=[A65536].End(xlUp)(2))
.Name = "" & I 'à adapter
.Refresh False
End With
Next I
v = Cells(14, 1).End(xlDown).Offset(17, 1).Address
Range(v).Select
Selection.EntireRow.Delete
On Error Resume Next
Range("H13:H" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

End Sub

 

[Zon]

Re,


Range("H13:H" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete te suffit pas pour avoir un tableau plus propre ?

Evites ces select sinon...

A+++

 

[albert]

Range("H13:H" & Range("A65536").End(xlUp).Row).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

ne supprime pas la ligne 214

Date Open High Low Close Volume Adj. Close*

 

[albert]

en fait, il va falloir que je trouve une procédure qui supprime les lignes grises, soit

.Interior.ColorIndex = 15

en-tête de chaque séries annuelles,
pour ne garder que celle sitée en ligne 13
Date Open High Low Close Volume Adj. Close*

parce que si j'allonge la période de téléchargement,
'----------télécharge------------
For I = 0 To 1000 Step 200
les en-tête de chaque séries annuelles ne sont pas situées à des distances constantes

c'est peut-être une méthode .Find qu'il faut que j'utilise, mais là, j'entre dans un domaine remplis de brouillard

 

[albert]

j'ai donc adapté le code suivant

Sub SUPadjclose()
Dim x As Integer

For x = Sheets("Feuil1").Range("A65536").End(xlUp).Row To 14 Step -1

If Sheets("Feuil1").Range("H" & x) = "Adj. Close*" Then Rows(x).Delete

Next
End Sub
et ça marche au poil

 

[albert]

peut-être que le résultat définitif intéressera quelqu'un