Option Explicit
Public Sub YahooQuotes()
Dim c As Range
Dim TickerString As String
Dim TickerSplitString() As String
Dim TickerSplitStringKurs As String
Dim TickerSplitStringVortag As String
Dim TickerSplitStringAenderung As String
Dim TickerSplitStringAenderungProz As String
Dim TickerSplitStringKursDatum As String
Dim TickerSplitStringKursZeit As String
Dim TickerSplitStringTagesspanne As String
Dim UeberschriftenZeile As Integer
Dim TickerAnzahl As Integer
Dim TickerSpalte As Integer
Dim KursSpalte As Integer
Dim VortagSpalte As Integer
Dim AenderungSpalte As Integer
Dim AenderungProzSpalte As Integer
Dim DatumSpalte As Integer
Dim UhrzeitSpalte As Integer
Dim KursString As String
Dim Adresse As String
Dim XML
Dim Handelstag As Date
Dim WertpapierTitle As String
Dim UpperCase
Dim TagesSpanne As String
Dim blattname As String
Dim oldStatusBar As String
Dim TitleSpalte As String
Dim x As Integer
Dim i As Integer
Dim AltTicker As String
Dim TickerID As String
Dim Anz_Ticker As Integer
Dim Market As String
Dim Quote As String
Dim aktueller_Kurs As Double
Dim TagesTief As Double
Dim TagesHoch As Double
Dim Vortag_Kurs As Double
Dim Veränderung_EUR As Double
Dim Veränderung_Pro As Integer
Dim Handelsuhrzeit As Date
Dim SchreibZeile As Integer
Dim ISIN As String
Dim Wertpapier_davor As String
Dim Tagesdatum As Date
Dim Investment As Double
Dim Tageswert As Double
Dim Zeile As Integer
On Error GoTo Fehler
Sheets("Depot").Activate
blattname = ActiveSheet.Name
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Verarbeitung läuft, bitte um Geduld ..."
Application.StatusBar = "Überschriftenzeile wird analysiert und Spaltenüberschriften gemerkt."
For Each c In Range("A5:Q5")
If c.Value Like "Name" Then UeberschriftenZeile = c.Row: TitleSpalte = c.Column
If c.Value Like "Ticker" Then TickerSpalte = c.Column
If c.Value Like "Kurs" Then KursSpalte = c.Column
If c.Value Like "Vortag" Then VortagSpalte = c.Column
If c.Value Like "Änderung" Then AenderungSpalte = c.Column
If c.Value Like "Änderung %" Then AenderungProzSpalte = c.Column
If c.Value Like "Kursdatum" Then DatumSpalte = c.Column
If c.Value Like "Kurszeit" Then UhrzeitSpalte = c.Column
Next
x = x + 1
i = UeberschriftenZeile + 1
If x = 1 Then AltTicker = 1
While Cells(i, TickerSpalte).Value <> ""
TickerID = Cells(i, TickerSpalte).Value
If AltTicker <> TickerID Then
If TickerID <> "leer" Then
TickerString = TickerString + Cells(i, TickerSpalte).Value + ","
AltTicker = TickerID
Anz_Ticker = Anz_Ticker + 1
End If
End If
i = i + 1
Wend
TickerAnzahl = Anz_Ticker - 1
Set XML = CreateObject("MSXML2.ServerXMLHTTP")
XML.Open "GET", Adresse, False
XML.send
KursString = XML.responsetext
TickerSplitString = Split(KursString, "}")
For i = 0 To TickerAnzahl
Sheets("tägl. Depot").Cells(4, 6) = KursString
Application.StatusBar = "Abruf der Wertpapierdaten von Yahoo: " & i & " von " & TickerAnzahl
TickerSplitStringKurs = Split(TickerSplitString(i), "shortName"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 2)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, """", "")
WertpapierTitle = TickerSplitStringKurs
TickerSplitStringKurs = Split(TickerSplitString(i), "fullExchangeName"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 2)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, """", "")
Market = TickerSplitStringKurs
TickerSplitStringKurs = Split(TickerSplitString(i), "regularMarketPrice"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 1)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, ".", ",")
Quote = CDbl(TickerSplitStringKurs)
aktueller_Kurs = Quote
TickerSplitStringTagesspanne = Split(TickerSplitString(i), "regularMarketDayRange"":")(1)
TickerSplitStringTagesspanne = Left(TickerSplitStringTagesspanne, InStr(TickerSplitStringTagesspanne, ",") - 2)
TickerSplitStringTagesspanne = Replace(TickerSplitStringTagesspanne, """", "")
TickerSplitStringTagesspanne = Replace(TickerSplitStringTagesspanne, ".", ",")
TagesSpanne = TickerSplitStringTagesspanne
TagesTief = Mid(TagesSpanne, 1, InStr(TagesSpanne, " - ") - 1): TagesTief = CDbl(TagesTief)
TagesHoch = Mid(TagesSpanne, InStr(TagesSpanne, " - ") + 3): TagesHoch = CDbl(TagesHoch)
TickerSplitStringVortag = Split(TickerSplitString(i), "regularMarketPreviousClose"":")(1)
TickerSplitStringVortag = Left(TickerSplitStringVortag, InStr(TickerSplitStringVortag, ",") - 1)
TickerSplitStringVortag = Replace(TickerSplitStringVortag, ".", ",")
Quote = CDbl(TickerSplitStringVortag)
Vortag_Kurs = Quote
TickerSplitStringAenderung = Split(TickerSplitString(i), "regularMarketChange"":")(1)
TickerSplitStringAenderung = Left(TickerSplitStringAenderung, InStr(TickerSplitStringAenderung, ",") - 1)
TickerSplitStringAenderung = Replace(TickerSplitStringAenderung, ".", ",")
Quote = CDbl(TickerSplitStringAenderung)
Veränderung_EUR = Quote
TickerSplitStringAenderungProz = Split(TickerSplitString(i), "regularMarketChangePercent"":")(1)
TickerSplitStringAenderungProz = Left(TickerSplitStringAenderungProz, InStr(TickerSplitStringAenderungProz, ",") - 1)
TickerSplitStringAenderungProz = Replace(TickerSplitStringAenderungProz, ".", ",")
Quote = CDbl(TickerSplitStringAenderungProz)
Veränderung_Pro = Quote
TickerSplitStringKursDatum = Split(TickerSplitString(i), "regularMarketTime"":")(1)
TickerSplitStringKursDatum = Left(TickerSplitStringKursDatum, InStr(TickerSplitStringKursDatum, ",") - 1)
Quote = TickerSplitStringKursDatum
Quote = DateAdd("s", Quote + 7200, "1.1.1970")
Handelstag = Left(Quote, 10)
Handelsuhrzeit = Right(Quote, 8)
Sheets("Historie").Activate
SchreibZeile = Cells(1, 11)
Cells(SchreibZeile, 1) = WertpapierTitle
Cells(SchreibZeile, 2).Select: ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-1],Depot!C:C[1],2,FALSE)": ISIN = Cells(SchreibZeile, 2): Cells(SchreibZeile, 2) = ISIN
Cells(SchreibZeile, 3) = Handelstag: Cells(SchreibZeile, 3).Select: Selection.NumberFormat = "dd/mm/yyyy"
Cells(SchreibZeile, 4) = <strong>Handelsuhrzeit:</strong> Cells(SchreibZeile, 4).Select: Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
Cells(SchreibZeile, 5) = Market
Cells(SchreibZeile, 6) =<strong> aktueller_Kurs:</strong> Cells(SchreibZeile, 6).Select: Selection.NumberFormat = "#,##0.00 $"
Cells(SchreibZeile, 7) = <strong>Veränderung_EUR:</strong> Cells(SchreibZeile, 7).Select: Selection.NumberFormat = "#,##0.00 $"
Veränderung_Pro = Veränderung_Pro / 100: Cells(SchreibZeile, 8) = Veränderung_Pro: Cells(SchreibZeile, 8).Select: Selection.NumberFormat = "0.00%":
Cells(SchreibZeile, 9) = TagesHoch: Cells(SchreibZeile, 9).Select: Selection.NumberFormat = "#,##0.00 $"
Cells(SchreibZeile, 10) = TagesTief: Cells(SchreibZeile, 10).Select: Selection.NumberFormat = "#,##0.00 $"
Cells(SchreibZeile, 11) = ISIN & "-" & Handelstag
Wertpapier_davor = TickerID
Next
Set XML = Nothing
Fehler:
Quote = 0
Set XML = Nothing
Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
Worksheets("Depot").Activate
Cells(6, 1).Select
Cells(3, 8).Select
End Sub