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 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
| Sub Thesis()
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name
Dim LastRow As Integer
Dim ChoixIndice As Integer
Dim Ltickers As Integer
Dim Ltable As Integer
Dim Lmatrix As Integer
Dim Cmatrix As Integer
Sheets("Sheet1").Activate
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Sheets("Results").Cells.Clear
'Ajout d'une colonne de dates entre les limites données dans la feuille "Results" (sans les weekends - cette partie n'est pas finie mais importe peu ici)
'Pour pouvoir coller les données de chaque action au bon endroit
'(Pas très important pour mon problème)
Set DataSheet = ActiveSheet
StartDate = Sheets("Sheet1").Cells(6, 2)
EndDate = Sheets("Sheet1").Cells(7, 2)
Lmatrix = 2
Cmatrix = 2
Sheets("Results").Cells(1, 1) = "Date"
While StartDate <= EndDate
If Weekday(StartDate) <> 1 And Weekday(StartDate) <> 7 Then
Sheets("Results").Cells(Lmatrix, 1) = StartDate
Lmatrix = Lmatrix + 1
End If
StartDate = StartDate + 1
Wend
'------------------------------
'Import des données
ChoixIndice = 1 '1 pour SP500, 2 pour Industrial DJ, 3 pour CAC40
'Parcourt la liste des tickers
Ltickers = 2
'Début de la boucle sur la liste des tickers
LoopLine:
While Sheets("Tickers").Cells(Ltickers, ChoixIndice) <> ""
Sheets("Data").Cells.Clear
Set DataSheet = ActiveSheet
StartDate = Sheets("Sheet1").Cells(6, 2)
EndDate = Sheets("Sheet1").Cells(7, 2)
Symbol = Sheets("Tickers").Cells(Ltickers, 1)
Sheets("Data").Range("a1").CurrentRegion.ClearContents
qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
"&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & Sheets("Data").Range("a1") & "&q=q&y=0&z=" & _
Symbol & "&x=.csv"
QueryQuote:
On Error GoTo ErrorImport 'J'ai donc ajouté le On Error GoTo ici qui renvoie en bas du programme
With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False 'C'est à cette ligne que le message d'erreur apparaît
.SaveData = True
End With
Sheets("Data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
Sheets("Data").Columns("A:G").ColumnWidth = 12
LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count
Sheets("Data").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Sheets("Data").Sort
.SetRange Range("A1:G" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
.SortFields.Clear
End With
'Report des données de Yahoo dans la matrice Results
Lmatrix = 2
Ltable = 2
'Recherche de la date de début dans Results
While Sheets("Results").Cells(Lmatrix, 1) <> Sheets("Data").Cells(Ltable, 1)
Lmatrix = Lmatrix + 1
Wend
'Report des valeurs de la colonne 6 de "Data" à la bonne date de début dans "Results"
Sheets("Results").Cells(1, Cmatrix) = Symbol
While Sheets("Data").Cells(Ltable, 7) <> ""
Sheets("Results").Cells(Lmatrix, Cmatrix) = Sheets("Data").Cells(Ltable, 7)
Lmatrix = Lmatrix + 1
Ltable = Ltable + 1
Wend
Ltickers = Ltickers + 1
Cmatrix = Cmatrix + 1
Wend
ErrorImport: 'Si erreur, incrémentation au ticker suivant et retour au début de la boucle
Ltickers = Ltickers + 1
GoTo LoopLine
End Sub |
Partager