Thema Datum  Von Nutzer Rating
Antwort
02.04.2012 18:35:23 Andrej Vogel
NotSolved
Blau Merkwürdiges Problem bei Webquery von Yahoo Finance in excel 2007
02.04.2012 18:49:55 Andrej Vogel
NotSolved

Ansicht des Beitrags:
Von:
Andrej Vogel
Datum:
02.04.2012 18:49:55
Views:
1970
Rating: Antwort:
  Ja
Thema:
Merkwürdiges Problem bei Webquery von Yahoo Finance in excel 2007

Nachtrag:

Damit ein möglicher Helfer hier schnell das Szenario simulieren kann, hier nochmal schnell funktionsfähiger Code.

 

- Tritt bei euch das oben beschrieben Problem auf?

Vielen Dank!

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
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
Sub DownloadKurse()
 
Dim startdate, enddate As Date
Dim aktie(3) As String
 
 
' Start- und Enddatum festlegen "YYYY-MM-DD"
startdate = "2011-01-01"
enddate = "2011-12-31"
 
'Ausschalten der Sichtbarkeit und Berechnungen während Download
Application.ScreenUpdating = False
 
aktie(3) = "CGYK.DE"
aktie(2) = "DAI.DE"
aktie(1) = "SG0T41.SG"
 
' Aufrufen der Routine zum Kursabruf
Call GetPrices(aktie, startdate, enddate)
 
'Aktivierung der Sichtbarkeit
Application.ScreenUpdating = True
 
' Setzen des sichtbaren Sheets
ThisWorkbook.Sheets("Tabelle1").Select
 
MsgBox ("Kursdownload via Yahoo erfolgreich beendet!")
 
End Sub
 
Sub GetPrices(aktie, startdate, enddate)
 
' GetPrices arbeitet mit zwei Sheets:
' 1. "GetPrices"
' 2. "GetPrices2"
' "GetPrices" dient als dauerhafte Speicherstelle für den Abruf anderer Module
Dim sheet1, sheet2 As String
sheet1 = "Tabelle1"
sheet2 = "Tabelle2"
 
' Meldungen deaktivieren
Application.DisplayAlerts = False
 
'Sheets vorbereiten
    Sheets(sheet1).Select
    Cells.Select
    Selection.ClearContents
    Sheets(sheet2).Select
    Cells.Select
    Selection.ClearContents
 
'Formatierung von sheet1
    Sheets(sheet1).Select
    Cells.Select
    Selection.NumberFormat = "#,##0.00"
    Columns("A:A").Select
    Selection.NumberFormat = "m/d/yyyy"
 
' Deklarierung der Variablen
Dim a, b, c, d, e, f As Integer
Dim i, i2, i3 As Integer ' HilfsIndex-Variablen
Dim g As String
Dim run As Integer
Dim preis As Double
Dim run2, run3 As Date
Dim genlink As String
 
 
' Aus "startdate" und "enddate" (Yahoo) auslesen
' Anpassung der Werte von a und d für Link
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" 'Intervall = daily
 
' Datumswerte schreiben
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
 
 
' Ermitteln der nötigen Durchläufe, um alle Aktien durchzugehen
run = UBound(aktie)
 
For i = 1 To run
ThisWorkbook.Sheets(sheet2).Select
 
'Link erzeugen
genlink = "URL;" & "http://ichart.finance.yahoo.com/table.csv?s=" & aktie(i) & _
"&a=" & a & "&b=" & b & "&c=" & c & "&d=" & d & "&e=" & e & "&f=" & f & "&g=" & g & "&ignore=.csv"
 
'Historische Kurse abrufen
With ActiveSheet.QueryTables.Add(Connection:=genlink, Destination:=Range("A1"))
 
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
 
End With 'Query
 
 
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
'Kopieren der Kurswerte in Spalte E in sheet1
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
 
'Ergänzung der "leeren" Stellen in sheet1
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
 
' Statt "Close" im Titel, soll als Titel Variable aktie stehen
.Sheets(sheet1).[a1].Offset(0, i).Value = aktie(i)
End With 'ThisWorkbook
 
' Löschen der Abfragewerte
Range(Selection, Selection.End(xlDown).End(xlToRight)).Select
Selection.QueryTable.Delete
Selection.ClearContents
 
Next i
 
' Leeren von sheet2
Sheets(sheet2).Select
Cells.Select
Selection.ClearContents
     
'nur diese Spalte ist makiert, nicht gesamter Bereich
Sheets(sheet2).Select
Sheets(sheet2).Range("A1").Select
Sheets(sheet1).Select
Sheets(sheet1).Range("A1").Select
 
End Sub

 


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
02.04.2012 18:35:23 Andrej Vogel
NotSolved
Blau Merkwürdiges Problem bei Webquery von Yahoo Finance in excel 2007
02.04.2012 18:49:55 Andrej Vogel
NotSolved