Guten Tag,
ich habe einen VBA-Code zum Teil zusammen kopiert, zum Teil erweitert und dieser Code läuft nun bei mir immer wieder an den gleichen Stellen auf Fehler.
Wenn ich den Code aber debugge, dann kommen keine Fehler und es läuft.
Warum funktioniert der Code aber nicht im regulärem Betrieb?
Die Fehler kommen alle in dem Bereich "Daten in Historie schreiben", also wenn ermittelte Daten in Zellen geschrieben und formatiert werden.
Hat jemand eine Idee?
'Die Symbole für die Wertpapiere findet man bei Yahoo
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 'Tabellenblatt-Ursprung
Dim oldStatusBar As String 'Statuszeile sichern
Dim TitleSpalte As String 'Wertpapier Name
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
'Statuszeile sichern
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.StatusBar = "Verarbeitung läuft, bitte um Geduld ..."
'Lokalisierung der Tabellenspalten
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
'Zusammenfügen der URL
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 '- (UeberschriftenZeile + 2)
Adresse = "https://query1.finance.yahoo.com/v7/finance/quote?symbols=" & TickerString
Set XML = CreateObject("MSXML2.ServerXMLHTTP")
XML.Open "GET", Adresse, False
XML.send
'Auslesen des Textes
KursString = XML.responsetext
'Zerlegen des ausgelesenen Textes
TickerSplitString = Split(KursString, "}")
For i = 0 To TickerAnzahl
'Auslesen des Wertpapier-Titels
Sheets("tägl. Depot").Cells(4, 6) = KursString
Application.StatusBar = "Abruf der Wertpapierdaten von Yahoo: " & i & " von " & TickerAnzahl
'If Ticker <> "leer" Then
'If Wertpapier_davor <> "" And Wertpapier_davor <> Ticker Then
'Auslesen des Aktiennamens
TickerSplitStringKurs = Split(TickerSplitString(i), "shortName"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 2)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, """", "")
'WertpapierTitle = StrConv(TickerSplitStringKurs, vbProperCase)
WertpapierTitle = TickerSplitStringKurs
'Auslesen des Handelsplatzes
TickerSplitStringKurs = Split(TickerSplitString(i), "fullExchangeName"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 2)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, """", "")
Market = TickerSplitStringKurs
'Auslesen des Kurses
TickerSplitStringKurs = Split(TickerSplitString(i), "regularMarketPrice"":")(1)
TickerSplitStringKurs = Left(TickerSplitStringKurs, InStr(TickerSplitStringKurs, ",") - 1)
TickerSplitStringKurs = Replace(TickerSplitStringKurs, ".", ",")
Quote = CDbl(TickerSplitStringKurs)
aktueller_Kurs = Quote
'Auslesen der Tagesspanne
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)
'Auslesen des Kurses vom Vortag
TickerSplitStringVortag = Split(TickerSplitString(i), "regularMarketPreviousClose"":")(1)
TickerSplitStringVortag = Left(TickerSplitStringVortag, InStr(TickerSplitStringVortag, ",") - 1)
TickerSplitStringVortag = Replace(TickerSplitStringVortag, ".", ",")
Quote = CDbl(TickerSplitStringVortag)
Vortag_Kurs = Quote
'Auslesen der Änderung zum Vortageskurs
TickerSplitStringAenderung = Split(TickerSplitString(i), "regularMarketChange"":")(1)
TickerSplitStringAenderung = Left(TickerSplitStringAenderung, InStr(TickerSplitStringAenderung, ",") - 1)
TickerSplitStringAenderung = Replace(TickerSplitStringAenderung, ".", ",")
Quote = CDbl(TickerSplitStringAenderung)
Veränderung_EUR = Quote
'Auslesen der prozentualen Änderung zum Vortageskurs
TickerSplitStringAenderungProz = Split(TickerSplitString(i), "regularMarketChangePercent"":")(1)
TickerSplitStringAenderungProz = Left(TickerSplitStringAenderungProz, InStr(TickerSplitStringAenderungProz, ",") - 1)
TickerSplitStringAenderungProz = Replace(TickerSplitStringAenderungProz, ".", ",")
Quote = CDbl(TickerSplitStringAenderungProz)
Veränderung_Pro = Quote
'Auslesen des Kursdatums und der Kurszeit
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)
'Daten in Historie schreiben
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) = Handelsuhrzeit: Cells(SchreibZeile, 4).Select: Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
Cells(SchreibZeile, 5) = Market
Cells(SchreibZeile, 6) = aktueller_Kurs: Cells(SchreibZeile, 6).Select: Selection.NumberFormat = "#,##0.00 $"
Cells(SchreibZeile, 7) = Veränderung_EUR: 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
'End If
'End If
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
|