Sub
DownloadKurse()
Dim
startdate, enddate
As
Date
Dim
aktie(3)
As
String
startdate =
"2011-01-01"
enddate =
"2011-12-31"
Application.ScreenUpdating =
False
aktie(3) =
"CGYK.DE"
aktie(2) =
"DAI.DE"
aktie(1) =
"SG0T41.SG"
Call
GetPrices(aktie, startdate, enddate)
Application.ScreenUpdating =
True
ThisWorkbook.Sheets(
"Tabelle1"
).
Select
MsgBox (
"Kursdownload via Yahoo erfolgreich beendet!"
)
End
Sub
Sub
GetPrices(aktie, startdate, enddate)
Dim
sheet1, sheet2
As
String
sheet1 =
"Tabelle1"
sheet2 =
"Tabelle2"
Application.DisplayAlerts =
False
Sheets(sheet1).
Select
Cells.
Select
Selection.ClearContents
Sheets(sheet2).
Select
Cells.
Select
Selection.ClearContents
Sheets(sheet1).
Select
Cells.
Select
Selection.NumberFormat =
"#,##0.00"
Columns(
"A:A"
).
Select
Selection.NumberFormat =
"m/d/yyyy"
Dim
a, b, c, d, e, f
As
Integer
Dim
i, i2, i3
As
Integer
Dim
g
As
String
Dim
run
As
Integer
Dim
preis
As
Double
Dim
run2, run3
As
Date
Dim
genlink
As
String
a = Format(Month(startdate) - 1,
"00"
)
b = Day(startdate)
c = Year(startdate)
d = Format(Month(enddate) - 1,
"00"
)
e = Day(enddate)
f = Year(enddate)
g =
"d"
With
ThisWorkbook.Sheets(sheet1)
.Range(
"A1"
).Value =
"Date"
run2 = startdate
Do
i2 = DateDiff(g, startdate, run2)
.Range(
"A1"
).Offset(i2 + 1, 0).Value = run2
run2 = DateAdd(g, 1, run2)
Loop
While
run2 <= enddate
End
With
run = UBound(aktie)
For
i = 1
To
run
ThisWorkbook.Sheets(sheet2).
Select
"&a="
& a &
"&b="
& b &
"&c="
& c &
"&d="
& d &
"&e="
& e &
"&f="
& f &
"&g="
& g &
"&ignore=.csv"
With
ActiveSheet.QueryTables.Add(Connection:=genlink, Destination:=Range(
"A1"
))
.BackgroundQuery =
True
.TablesOnlyFromHTML =
False
.Refresh BackgroundQuery:=
False
.SaveData =
True
End
With
ThisWorkbook.Sheets(sheet2).Range(
"A1"
).
Select
Range(Selection, Selection.
End
(xlDown)).
Select
Selection.TextToColumns _
Destination:=Range(
"A1"
), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=
False
, _
Tab:=
True
, _
Semicolon:=
False
, _
Comma:=
True
, _
Space:=
False
, _
Other:=
False
With
ThisWorkbook
For
Each
zelle
In
Range(
"E2:E500"
)
Select
Case
zelle.Value
Case
Is
<>
""
i2 = DateDiff(g, startdate, zelle.Offset(0, -4).Value)
.Sheets(sheet1).[a1].Offset(i2 + 1, i).Font.ColorIndex = 1
.Sheets(sheet1).[a1].Offset(i2 + 1, i).Value = zelle.Value
End
Select
Next
zelle
For
i3 = 2
To
DateDiff(g, startdate, enddate)
If
.Sheets(sheet1).[a1].Offset(i3 + 1, i).Value =
""
Then
.Sheets(sheet1).[a1].Offset(i3 + 1, i).Font.ColorIndex = 3
.Sheets(sheet1).[a1].Offset(i3 + 1, i).Value = .Sheets(sheet1).[a1].Offset(i3, i).Value
End
If
Next
.Sheets(sheet1).[a1].Offset(0, i).Value = aktie(i)
End
With
Range(Selection, Selection.
End
(xlDown).
End
(xlToRight)).
Select
Selection.QueryTable.Delete
Selection.ClearContents
Next
i
Sheets(sheet2).
Select
Cells.
Select
Selection.ClearContents
Sheets(sheet2).
Select
Sheets(sheet2).Range(
"A1"
).
Select
Sheets(sheet1).
Select
Sheets(sheet1).Range(
"A1"
).
Select
End
Sub