Thema Datum  Von Nutzer Rating
Antwort
Rot VBA läuft auf Fehler, debuggin läuft o. Fehler durch
07.06.2020 17:06:16 Cölestin
Solved
07.06.2020 17:08:44 Gast79266
NotSolved
07.06.2020 17:14:51 Gast83063
NotSolved

Ansicht des Beitrags:
Von:
Cölestin
Datum:
07.06.2020 17:06:16
Views:
1192
Rating: Antwort:
 Nein
Thema:
VBA läuft auf Fehler, debuggin läuft o. Fehler durch

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


 


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
Rot VBA läuft auf Fehler, debuggin läuft o. Fehler durch
07.06.2020 17:06:16 Cölestin
Solved
07.06.2020 17:08:44 Gast79266
NotSolved
07.06.2020 17:14:51 Gast83063
NotSolved