Option Explicit
'--------------------------------------------------------
' Korrekturen/Änderungen:
' überträgt RoE, EBIT-Marge und EK-Quote und die EPS-Werte bis einschl. letztem Geschäftsjahr aus dem vorigen Tabellenblatt, wenn bei OnVista nicht vorhanden
' die Daten zur Reaktion auf Quartalszahlen werden bei gleichbleibendem Termin bzw. Benchmark aus dem vorigen Bewertungsblatt übernommen (spart Web-Zugriffe)
' ebenso für das Dreimonatsreversal
' zum Laden der historischen Kurse die CSV-URLs genutzt, geht wahrscheinlich schneller
' Bemerkungen werden aus dem vorigen Tabellenblatt übertragen mit davorstehendem Datum (Blattnamen)
' Überarbeiten für englisches bzw. amerikanisches Windows
' korrektes Aufräumen alle QueryTable-Reste
' Laden der historischen KGV für zweite Varinate der KGV-Kriterien-Berechnung
'--------------------------------------------------------
'Spaltennummern im Tabellenblatt "Aktien" und "Vorlage" (also auch in den Bewertungsblättern)
Const SPALTE_NAME = 1
Const SPALTE_ISIN = 2
Const SPALTE_GROESSE = 3
Const SPALTE_ART = 4
'Spaltennummern im Tabellenblatt "Aktien"
Const SPALTE_BOERSE = 5 'der Kurs dieser Börse wird verwendet, sofern vorhanden, wenn leer, wird einfach der aktuelleste Kurs genommen
Const SPALTE_FINANZEN_NET = 6 'hier steht der URL-Teil für finanzen.net
Const SPALTE_ONVISTA = 7 'hier steht der URL-Teil für onvista.de
Const SPALTE_YAHOO = 8 'URL-Teil für yahoo.de
Const SPALTE_HIST_ONVISTA = 9 'URL-Teil zur Abfrage historischer Kurse bei OnVista
Const SPALTE_BENCHMARK_NAME = 10 'Bezeichnung der Benchmark (des Vergleichsindex)
Const SPALTE_BENCHMARK_YAHOO = 11 'Teil der Yahoo-URL für die Benchmark
Const SPALTE_BENCHMARK_HIST_ONVISTA = 12 'Teil der Onvista-URL zur Abfrage historischer Kurse für die Benchmark
Const SPALTE_4TRADERS = 13 'URL-Teil für de.4-traders.com
Const SPALTE_TERMINE = 14 'Ab dieser Spalte können Quartalszahlentermine eingetragen sein.
'Spalten im Tabellenblatt "Vorlage" bzw. in den daraus erzeugten Bewertungsblättern
'In diese Spalten werden jaweils die aus dem Web ausgelesenen Daten geschrieben.
'--------------------------------------------------------------------------------------------------
Const SPALTE_DATUM = 5
Const SPALTE_KURS = 6
'--------------------------------------------------------------------------------------------------
Const SPALTE_LJ = 7 'letztes Geschäftsjahr
Const SPALTE_ROE = 8
Const SPALTE_EBITMARGE = 9
Const SPALTE_EKQUOTE = 10
'--------------------------------------------------------------------------------------------------
'Spalten für EPS (earnings per share = Gewinn pro Aktie) über 5 Geschäftsjahre
'vom vorvorletzten bis zum nächsten Geschäftsjahr
Const SPALTE_EPSLJ2 = 11
Const SPALTE_EPSLJ1 = 12
Const SPALTE_EPSLJ = 13
Const SPALTE_EPSAJ = 14
Const SPALTE_EPSNJ = 15
'--------------------------------------------------------------------------------------------------
Const SPALTE_ANALYSTENANZAHL = 20
Const SPALTE_ANALYSTENMEINUNG = 21
'--------------------------------------------------------------------------------------------------
'Spalten für Daten zur Berechnung der Reaktion auf Quartalszahlen
Const SPALTE_MARKTKAP = 22 'nur informativ - nicht zur Berechnung
Const SPALTE_BENCHMARK = 23
Const SPALTE_DATUMZAHLEN = 24
Const SPALTE_DATUMVORTAG = 25
Const SPALTE_KURSZAHLEN = 26
Const SPALTE_KURSVORTAG = 27
Const SPALTE_BENCHMARKKURS = 28
Const SPALTE_BENCHMARKVORTAG = 29
'--------------------------------------------------------------------------------------------------
'Spalten für die Berechnung der Gewinnrevisionen sind jeweils die 4 direkt links von diesen
Const SPALTE_EPSAJ_WDH = 37
Const SPALTE_EPSNJ_WDH = 42
'--------------------------------------------------------------------------------------------------
'Spalten zur Berechnung der Kursentwicklung über 6 Monate bzw. 1 Jahr
Const SPALTE_DATUM6MON = 45
Const SPALTE_KURS6MON = 46
Const SPALTE_DATUM1JAHR = 49
Const SPALTE_KURS1JAHR = 50
'--------------------------------------------------------------------------------------------------
'Spalten zur Berechnung des Dreimonatsreversals (nur für Large Caps)
Const SPALTE_DATUM3MON = 54
Const SPALTE_KURS3MON = 55
Const SPALTE_BENCHMARK3MON = 56
Const SPALTE_DATUM2MON = 57
Const SPALTE_KURS2MON = 58
Const SPALTE_BENCHMARK2MON = 59
Const SPALTE_DATUM1MON = 62
Const SPALTE_KURS1MON = 63
Const SPALTE_BENCHMARK1MON = 64
Const SPALTE_DATUM0MON = 67
Const SPALTE_KURS0MON = 68
Const SPALTE_BENCHMARK0MON = 69
'--------------------------------------------------------------------------------------------------
'Punktespalten im Bewertngsblatt - für Export
Const SPALTE_PKT_ROE = 75
Const SPALTE_PKT_EBITMARGE = 76
Const SPALTE_PKT_EKQUOTE = 77
Const SPALTE_KGV5 = 18
Const SPALTE_KGVA = 19
Const SPALTE_PKT_KGV5 = 78
Const SPALTE_PKT_KGVA = 79
Const SPALTE_PKT_ANALYSTEN = 80
Const SPALTE_QZDIFF = 32
Const SPALTE_PKT_QZ = 81
Const SPALTE_REVIAJ = 43
Const SPALTE_REVINJ = 44
Const SPALTE_PKT_REVI = 82
Const SPALTE_ENTW6M = 48
Const SPALTE_PKT_ENTW6M = 83
Const SPALTE_ENTW1J = 52
Const SPALTE_PKT_ENTW1J = 84
Const SPALTE_PKT_MOMENTUM = 85
Const SPALTE_GEWINNWACHSTUM = 74
Const SPALTE_PKT_GEWINNWACHSTUM = 87
Const SPALTE_PKT_GESAMT = 88
'--------------------------------------------------------------------------------------------------
Const SPALTE_BEMERKUNGEN = 90
'--------------------------------------------------------------------------------------------------
'KGV-Spalten für die zweite Berechnungsvariante des KGV-Kriteriums
'vom vorvorletzten bis zum aktuellen Geschäftsjahr
Const SPALTE_KGVLJ2 = 91
Const SPALTE_KGVLJ1 = 92
Const SPALTE_KGVLJ = 93
Const SPALTE_KGVAJ = 94
'--------------------------------------------------------------------------------------------------
'In neueren Excel-Versionen funktioniert die historische Kursabfrage von Yahoo nicht.
'Wenn der Zugriff einmal schief geht, wird das in der globalen Variable gespeichert und nicht wieder versucht.
Dim keinYahoo As Boolean
Sub A_alle_Bewertungen_erzeugen()
'Legt ein neues Tabellenblatt mit aktuellem Datum der Form JJJJ-MM-TT an.
'Erzeugt zu jeder Zeile das Blattes "Aktien" eine Zeile in diesem neuen Blatt und holt _
jeweils die Daten für die Bewertung aus dem Internet.
Dim sh As Worksheet
keinYahoo = False
Set sh = NeuesBlattAnlegen()
If Not (sh Is Nothing) Then
Call AktienUebertragenDatenHolen(sh, 0)
Sheets(Sheets.Count).Activate
Application.StatusBar = "OK"
End If
End Sub
Sub B_Bewertungen_ab_dieser_Zeile_erzeugen()
'Wird ausgehend von einer Zeile in einem Bewertungsblatt gestartet.
'Überschreibt im aktuellen Bewertungsblatt ab dieser Zeile mit neu geladenen Daten.
Dim sh As Worksheet
Dim zeile As Long
Dim isin As String
keinYahoo = False
Set sh = ActiveSheet
If Not (sh.Name Like "####-##-##") Then
'kein Bewertungsblatt
Exit Sub
End If
zeile = ActiveCell.Row
If zeile = 1 Then
'Überschriftenzeile
Exit Sub
End If
isin = CStr(sh.Cells(zeile, SPALTE_ISIN).Value)
If isin = "" Then
'keine Aktien-Zeile
Exit Sub
End If
Call AktienUebertragenDatenHolen(sh, zeile)
sh.Activate
Application.StatusBar = "OK"
End Sub
Sub C_diese_Bewertungszeile_aktualisieren()
'Wird ausgehend von einer Zeile im Bewertungsblatt gestartet.
'Überschriebt diese Zeile mit neu geladenen Daten.
keinYahoo = False
Dim sh As Worksheet
Dim zeile As Long
Dim isin As String
Dim shA As Worksheet
Dim shQ As Worksheet
Dim qt As QueryTable
Set sh = ActiveSheet
If Not (sh.Name Like "####-##-##") Then
'kein Bewertungsblatt
Exit Sub
End If
zeile = ActiveCell.Row
If zeile = 1 Then
'Überschriftenzeile
Exit Sub
End If
isin = CStr(sh.Cells(zeile, SPALTE_ISIN).Value)
If isin = "" Then
'keine Aktien-Zeile
Exit Sub
End If
Set shA = Sheets("Aktien")
Call HoleQuerySheetUndQueryTable(shQ, qt)
Application.StatusBar = "aktuelle Zeile"
Call DatenZurISINHolen(isin, zeile, shA, shQ, qt, sh)
'Aufräumen:
Call shQ.Cells.Clear
For Each qt In shQ.QueryTables
Call qt.Delete
Next
Call sh.Activate
Application.StatusBar = "OK"
End Sub
Function NeuesBlattAnlegen() As Worksheet
'Legt ein neues Tabellenblatt als Kopie von "Vorlage" an und benennt es mit aktuellem Datum _
der Form JJJJ-MM-TT.
'Überträgt die Berechnungsformeln aus der Vorlage auf den späteren gesamten Datenbereich _
des neuen Bewertungsblattes.
'wird benutzt in Makro A_alle_Bewertungen_erzeugen
Dim blattName As String
Dim sh As Worksheet
Dim shV As Worksheet
Dim shA As Worksheet
Dim maxSpalte As Long
Dim maxZeile As Long
Dim rng As Range
Dim rngVoll As Range
blattName = Format(Now, "yyyy-mm-dd")
'Es darf nur ein Tabellenblatt dieses Namens geben:
On Error Resume Next
Set sh = Sheets(blattName)
On Error GoTo 0
If Not (sh Is Nothing) Then
Call sh.Select
Call MsgBox("Tabellenblatt """ + blattName + """ gibt es schon.", vbOKOnly + _
vbExclamation, "Blatt schon vorhanden")
Call sh.Delete
'Prüfen, ob wirklich gelöscht wurde:
Set sh = Nothing
On Error Resume Next
Set sh = Sheets(blattName)
On Error GoTo 0
If Not (sh Is Nothing) Then
'Im Löschen-Dialog wurde "Abbrechen" geklickt.
Exit Function
End If
End If
'Ermitteln, bis zu welcher Zeile bzw. Spalte das neue Bewertungsblatt am Ende ausgefüllt _
sein wird. ( maxZeile bzw. maxSpalte )
Set shV = Sheets("Vorlage")
maxSpalte = 3
Do Until CStr(shV.Cells(1, maxSpalte).Value) = ""
maxSpalte = maxSpalte + 1
Loop
maxSpalte = maxSpalte - 1
Set shA = Sheets("Aktien")
maxZeile = 2
Do Until CStr(shA.Cells(maxZeile, 1).Value) = ""
maxZeile = maxZeile + 1
Loop
maxZeile = maxZeile - 1
'Anlegen des neuen Bewertungsblattes als letztes Blatt der Arbeitsmappe:
Set sh = Sheets(Sheets.Count)
Call shV.Copy(, sh)
Set sh = Sheets(Sheets.Count)
sh.Name = blattName
'Übertragen der Berechnungsformeln aus der Vorlage auf den gesamten Datenbereich des neuen _
Bewertungsblattes:
Set rng = sh.Range(sh.Cells(2, SPALTE_ISIN + 1), sh.Cells(2, maxSpalte))
Set rngVoll = sh.Range(sh.Cells(2, SPALTE_ISIN + 1), sh.Cells(maxZeile, maxSpalte))
Call rng.AutoFill(rngVoll)
Set NeuesBlattAnlegen = sh 'das vorbereitete neue Bewertungsblatt
End Function
Function AktienUebertragenDatenHolen(sh As Worksheet, abZeile As Long)
'Überträgt die Aktien (jeweils Name und ISIN) aus dem Tabellenblatt "Aktien" in das _
Bewertungsblatt (sh), sofern nötig.
'Ruft die benötigten Daten aus dem Internet ab und trägt sie ein.
'Parameter: sh = Ziel-Bewertungsblatt
' abZeile = ab welcher Zeile des Bewertungsblattes mit dem Holen der Daten _
negonnen wird
'wird benutzt in
' Makro A_alle_Bewertungen_erzeugen --> abZeile = 0
' Makro B_Bewertungen_ab_dieser_Zeile_erzeugen --> abZeile = Nummer der Zeile, _
ab der das passieren soll
Dim shA As Worksheet
Dim shQ As Worksheet
Dim qt As QueryTable
Dim zeile As Long
Dim aktie As String
Dim isin As String
Dim K As Long
Set shA = Sheets("Aktien")
Call HoleQuerySheetUndQueryTable(shQ, qt) 'Hilfsblatt für Web-Abfragen bzw. Tabelle _
zum Auslesen der abgefragten Daten
If abZeile = 0 Then
'Name, ISIN und Größe zur Aktie übertragen, denn das Bewertungsblatt wurde gerade neu _
angelegt
zeile = 2
Do Until CStr(shA.Cells(zeile, SPALTE_NAME).Value) = ""
sh.Cells(zeile, SPALTE_NAME).Value = shA.Cells(zeile, SPALTE_NAME).Value
sh.Cells(zeile, SPALTE_ISIN).Value = shA.Cells(zeile, SPALTE_ISIN).Value
sh.Cells(zeile, SPALTE_GROESSE).Value = shA.Cells(zeile, SPALTE_GROESSE).Value
sh.Cells(zeile, SPALTE_ART).Value = shA.Cells(zeile, SPALTE_ART).Value
zeile = zeile + 1
Loop
zeile = 2
Else
zeile = abZeile
End If
'Daten zu den Aktien holen und eintragen
Do Until CStr(sh.Cells(zeile, SPALTE_NAME).Value) = ""
aktie = sh.Cells(zeile, SPALTE_NAME).Value
Application.StatusBar = "Zeile " + CStr(zeile) + " - " + aktie
DoEvents
isin = sh.Cells(zeile, SPALTE_ISIN).Value
Call DatenZurISINHolen(isin, zeile, shA, shQ, qt, sh)
If zeile Mod 50 = 0 Then
Call shQ.Cells.Clear
sh.Parent.Save
End If
zeile = zeile + 1
Loop
'Aufräumen:
Call shQ.Cells.Clear
For Each qt In shQ.QueryTables
Call qt.Delete
Next
End Function
Function HoleQuerySheetUndQueryTable(ByRef shQ As Worksheet, ByRef qt As QueryTable)
'Holt das Tabellenblatt "Query" als Hilfsblatt für die Web-Abfragen (--> Worksheet shQ)
'und bereitet darin eine Tabelle (--> QueryTable qr) zum Auslesen der Web-Daten vor.
'wird verwendet in
' AktienUebertragenDatenHolen
' C_diese_Bewertungszeile_aktualisieren
Set shQ = Sheets("Query")
'Reste (z.B. durch vorherigen Abbruch) entfernen:
Call shQ.Cells.Clear
For Each qt In shQ.QueryTables
Call qt.Delete
Next
'Abfrage vorbereiten:
Set qt = shQ.QueryTables.Add("URL;", shQ.Cells(1, 1))
With qt
.Name = "Aktie"
.BackgroundQuery = False 'die Abfragen müssen immer synchron laufen
.RefreshStyle = xlInsertDeleteCells
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebDisableDateRecognition = True
End With
End Function
Function DatenZurISINHolen(isin As String, zeile As Long, shA As Worksheet, shQ As Worksheet, _
qt As QueryTable, sh As Worksheet)
'Fragt zu gegebener ISIN einer Aktie alle benötigten Daten aus dem Web ab und trägt diese _
in die zugehörige Zeile des aktuellen Bewertungsblattes ein.
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
'wird verwendet in
' AktienUebertragenDatenHolen
' C_diese_Bewertungszeile_aktualisieren
Dim quellZeile As Long
Dim K As Long
Dim shVorher As Worksheet
Dim zeileVorher As Long
If CStr(shA.Cells(zeile, SPALTE_ISIN).Value) = isin Then
'Die Aktie steht im Bewertungsblatt in der gleichen Zeile wie im Blatt "Aktien".
quellZeile = zeile
Else
'Suchen die Zeile mit der ISIN im Tabellenblatt "Aktien":
quellZeile = 2
Do Until CStr(shA.Cells(quellZeile, SPALTE_ISIN).Value) = ""
If CStr(shA.Cells(quellZeile, SPALTE_ISIN).Value) = isin Then
GoTo gefunden
End If
quellZeile = quellZeile + 1
Loop
Exit
Function 'keine passende Zeile gefunden
gefunden:
End If
'Tabellenblatt mit der vorigen Bewertung holen, sofern vorhanden:
For K = 1 To Sheets.Count
If Sheets(K).Name = sh.Name Then
If K > 1 Then
If Sheets(K - 1).Name Like "####-##-##" Then
Set shVorher = Sheets(K - 1)
Exit For
End If
End If
End If
Next
'passende Zeile im vorigen Bewertungsblatt suchen:
If Not (shVorher Is Nothing) Then
If CStr(shVorher.Cells(zeile, SPALTE_ISIN).Value) = isin Then
zeileVorher = zeile
GoTo gefundenVorher
End If
K = 2
Do Until CStr(shVorher.Cells(K, SPALTE_ISIN).Value) = ""
If CStr(shVorher.Cells(K, SPALTE_ISIN).Value) = isin Then
zeileVorher = K
GoTo gefundenVorher
End If
K = K + 1
Loop
gefundenVorher:
End If
Call AktuellerTerminUndKursZurISIN(isin, zeile, quellZeile, shA, shQ, qt, sh)
Call OnVistaDaten(isin, zeile, quellZeile, shA, shQ, qt, sh, shVorher, zeileVorher)
Call Marktkapitalisierung(isin, zeile, quellZeile, shA, shQ, qt, sh)
Call Quartalszahlen(isin, zeile, quellZeile, shA, shQ, qt, sh, shVorher, zeileVorher)
Call AnalystenMeinungen(isin, zeile, quellZeile, shA, shQ, qt, sh)
Call GewinnRevisionen(isin, zeile, sh, shVorher, zeileVorher)
Call HistorischeKurse(isin, zeile, quellZeile, shA, shQ, qt, sh)
Call DreiMonatsReversal(isin, zeile, quellZeile, shA, shQ, qt, sh, shVorher, zeileVorher)
Call Bemerkungen(isin, zeile, sh, shVorher, zeileVorher)
End Function
Function AktuellerTerminUndKursZurISIN(isin As String, zeile As Long, quellZeile As Long, shA _
As Worksheet, shQ As Worksheet, qt As QueryTable, sh As Worksheet)
'Holt den letzten Kurs und das Datum, von wenn dieser ist, trägt das ins Ziel- _
Bewertungsblatt in die Zeile zur ISIN ein.
'benutzt dazu finanzen.net
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Const URL_ANFANG = "URL;http://www.finanzen.net/boersenplaetze/"
Dim urlTeil As String
Dim url As String
Dim rng As Range
Dim Z As Long
Dim terminDef As Variant
Dim kursDef As Double
Dim termin As Variant
Dim Kurs As Double
Dim inhalt As String
sh.Cells(zeile, SPALTE_DATUM).Value = ""
sh.Cells(zeile, SPALTE_KURS).Value = ""
terminDef = Empty
termin = Empty
'Seite aus dem Web abrufen:
urlTeil = shA.Cells(quellZeile, SPALTE_FINANZEN_NET).Value
If urlTeil = "" Then
Exit Function
End If
url = URL_ANFANG + urlTeil
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'benötigte Daten extrahieren:
Set rng = shQ.Cells.Find("Deutsche Börsenübersicht", shQ.Cells(1, 1))
If Not rng Is Nothing Then
Z = rng.Row + 2
Do Until CStr(shQ.Cells(Z, 1).Value) = ""
If CStr(shQ.Cells(Z, 1).Value) = "Börse" Then
If CStr(shQ.Cells(Z + 1, 1).Value) "" Then
'dort steht die Default-Börse
inhalt = CStr(shQ.Cells(Z + 1, 2).Value)
If inhalt Like "* EUR" Then
inhalt = MeinSystemFormat(Replace(inhalt, " EUR", ""))
If IsNumeric(inhalt) Then
kursDef = CDbl(inhalt)
End If
inhalt = CStr(shQ.Cells(Z + 1, 9).Value)
terminDef = DatumsWert(inhalt)
End If
End If
End If
If CStr(shQ.Cells(Z, 1).Value) = shA.Cells(zeile, SPALTE_BOERSE).Value Then
'passende Börse
inhalt = CStr(shQ.Cells(Z, 2).Value)
If inhalt Like "* EUR" Then
inhalt = MeinSystemFormat(Replace(inhalt, " EUR", ""))
If IsNumeric(inhalt) Then
Kurs = CStr(inhalt)
End If
inhalt = CStr(shQ.Cells(Z, 9).Value)
termin = DatumsWert(inhalt)
End If
End If
Z = Z + 1
Loop
If Not (IsEmpty(termin)) And (Kurs > 0) Then
'Datum und Kurs zur gewünschten Börse gefunden
If Not (IsEmpty(terminDef)) And (kursDef > 0) Then
'Datum und Kurs zur Default-Börse gefunden
If (terminDef > termin) Then
'Angaben der Default-Börse sind aktueller - nehme diese
termin = terminDef
Kurs = kursDef
End If
End If
Else
'Datum/Kurs zur gewünschten Börse nicht gefunden
If Not (IsEmpty(terminDef)) And (kursDef > 0) Then
'es gibt Default-Werte, die werden genommen
termin = terminDef
Kurs = kursDef
End If
End If
End If
'Werte in Bewertungstabelle eintragen:
If Not (IsEmpty(termin)) And (Kurs > 0) Then
sh.Cells(zeile, SPALTE_DATUM).Value = termin
sh.Cells(zeile, SPALTE_KURS).Value = Kurs
End If
End Function
Function OnVistaDaten(isin As String, zeile As Long, quellZeile As Long, shA As Worksheet, shQ _
As Worksheet, qt As QueryTable, sh As Worksheet, shVorher As Worksheet, zeileVorher As Long)
'Holt RoE, EBIT-Marge, Eigenkapitalquote des letzten Geschäftsjahres,
'sowie EPS über fünf Geschäftsjahre (vorvorletztes, vorletztes, letztes, aktuelles geschä _
tzt, nächstes geschätzt).
'Trägt die Daten ins Ziel-Bewertungsblatt in die Zeile zur ISIN ein.
'benutzt dazu onvista.de
'wenn etwas bei onvista nicht vorhanden ist, wird es aus der passenden Zeile aus dem _
vorigen Bewertungsblatt übernommen,
'um manuelle Einträge zu erhalten
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
' shVorher voriges Bewertungsblatt
' zeileVorher Zeile dieser Aktie im vorigen Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Const URL_ANFANG = "URL;http://www.onvista.de/aktien/fundamental/"
Dim urlTeil As String
Dim url As String
Dim rng As Range
Dim zeileJahr As Long
Dim spalteLJ As Long
Dim K As Long
Dim wert As Variant
Dim inhalt As String
Dim LJ As String
Dim gleichesLJ As Boolean
Dim zeileRent As Long
Dim spalteRent As Long
Dim zeileEK As Long
Dim spalteEK As Long
Dim zeileEPS As Long
Dim zeileKGV As Long
sh.Cells(zeile, SPALTE_LJ).Value = ""
sh.Cells(zeile, SPALTE_ROE).Value = ""
sh.Cells(zeile, SPALTE_EBITMARGE).Value = ""
sh.Cells(zeile, SPALTE_EKQUOTE).Value = ""
sh.Cells(zeile, SPALTE_EPSLJ2).Value = ""
sh.Cells(zeile, SPALTE_EPSLJ1).Value = ""
sh.Cells(zeile, SPALTE_EPSLJ).Value = ""
sh.Cells(zeile, SPALTE_EPSAJ).Value = ""
sh.Cells(zeile, SPALTE_EPSNJ).Value = ""
sh.Cells(zeile, SPALTE_KGVLJ2).Value = ""
sh.Cells(zeile, SPALTE_KGVLJ1).Value = ""
sh.Cells(zeile, SPALTE_KGVLJ).Value = ""
sh.Cells(zeile, SPALTE_KGVAJ).Value = ""
'Seite aus dem Internet laden
urlTeil = shA.Cells(quellZeile, SPALTE_ONVISTA).Value
If urlTeil = "" Then
Exit Function
End If
url = URL_ANFANG + urlTeil
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'Letztes Geschäftsjahr heraussuchen:
Set rng = shQ.Cells.Find("Gewinn", shQ.Cells(1, 1))
If Not rng Is Nothing Then
zeileJahr = rng.Row
K = 2
Do Until CStr(shQ.Cells(zeileJahr, K).Value) = ""
inhalt = CStr(shQ.Cells(zeileJahr, K).Value)
If (inhalt Like "####") Or (inhalt Like "##/##") Then
spalteLJ = K
LJ = inhalt
Exit Do
End If
K = K + 1
Loop
sh.Cells(zeile, SPALTE_LJ).Value = LJ
End If
If LJ "" Then
'schauen, ob es eine vorige Bewertung mit gleichem Geschäftsjahr gibt
gleichesLJ = False
If zeileVorher > 1 Then
If CStr(shVorher.Cells(zeileVorher, SPALTE_LJ).Value) = LJ Then
gleichesLJ = True
End If
End If
'RoE und EBIT-Marge:
Set rng = shQ.Cells.Find("Rentabilität Mehr", shQ.Cells(1, 1))
If Not rng Is Nothing Then
zeileRent = rng.Row
For K = 2 To 10
If CStr(shQ.Cells(zeileRent, K).Value) = LJ Then
spalteRent = K
Exit For
End If
Next
If spalteRent > 0 Then
For K = 20 To 25
If shQ.Cells(zeileRent + K, 1).Value = "Eigenkapitalrendite" Then
wert = MeinProzentWert(shQ.Cells(zeileRent + K, spalteRent).Value)
If IsNumeric(wert) And (CStr(wert) "") Then
sh.Cells(zeile, SPALTE_ROE).Value = wert
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen _
Bewertung
sh.Cells(zeile, SPALTE_ROE).Value = shVorher.Cells(zeileVorher, _
SPALTE_ROE).Value
End If
End If
Else
If shQ.Cells(zeileRent + K, 1).Value = "EBIT-Marge" Then
wert = MeinProzentWert(shQ.Cells(zeileRent + K, spalteRent).Value)
If IsNumeric(wert) And (CStr(wert) "") Then
sh.Cells(zeile, SPALTE_EBITMARGE).Value = wert
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen _
Bewertung
sh.Cells(zeile, SPALTE_EBITMARGE).Value = shVorher.Cells( _
zeileVorher, SPALTE_EBITMARGE).Value
End If
End If
End If
End If
Next
Else
'keine Angaben zum aktuellen Geschäftsjahr - vielleicht manuell im vorigen _
Blatt
If gleichesLJ Then
sh.Cells(zeile, SPALTE_ROE).Value = shVorher.Cells(zeileVorher, SPALTE_ROE). _
Value
sh.Cells(zeile, SPALTE_EBITMARGE).Value = shVorher.Cells(zeileVorher, _
SPALTE_EBITMARGE).Value
End If
End If
End If
'EK-Quote
Set rng = shQ.Cells.Find("Bilanz Mehr", shQ.Cells(1, 1))
If Not rng Is Nothing Then
zeileEK = rng.Row
For K = 2 To 10
If shQ.Cells(zeileEK, K).Value = LJ Then
spalteEK = K
Exit For
End If
Next
If spalteEK > 0 Then
For K = 13 To 20
If shQ.Cells(zeileEK + K, 1).Value = "Eigenkapitalquote" Then
wert = MeinProzentWert(shQ.Cells(zeileEK + K, spalteEK).Value)
If IsNumeric(wert) And (CStr(wert) "") Then
sh.Cells(zeile, SPALTE_EKQUOTE).Value = wert
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen _
Bewertung
sh.Cells(zeile, SPALTE_EKQUOTE).Value = shVorher.Cells( _
zeileVorher, SPALTE_EKQUOTE).Value
End If
End If
End If
Next
Else
'keine Angaben zum aktuellen Geschäftsjahr - vielleicht manuell im vorigen _
Blatt
If gleichesLJ Then
sh.Cells(zeile, SPALTE_EKQUOTE).Value = shVorher.Cells(zeileVorher, _
SPALTE_EKQUOTE).Value
End If
End If
End If
'EPS-Werte und (historische) KGV:
For K = 7 To 15
If shQ.Cells(zeileJahr + K, 1).Value = "Gewinn pro Aktie in EUR" Then
zeileEPS = zeileJahr + K
zeileKGV = zeileEPS + 1
Exit For
End If
Next
If zeileEPS > 0 Then
'EPS-Werte:
inhalt = MeinSystemFormat(shQ.Cells(zeileEPS, spalteLJ + 2).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_EPSLJ2).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_EPSLJ2).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSLJ2).Value
End If
End If
inhalt = MeinSystemFormat(shQ.Cells(zeileEPS, spalteLJ + 1).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_EPSLJ1).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_EPSLJ1).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSLJ1).Value
End If
End If
inhalt = MeinSystemFormat(shQ.Cells(zeileEPS, spalteLJ).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_EPSLJ).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_EPSLJ).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSLJ).Value
End If
End If
If spalteLJ > 2 Then
inhalt = MeinSystemFormat(shQ.Cells(zeileEPS, spalteLJ - 1).Value)
If IsNumeric(inhalt) Then
sh.Cells(zeile, SPALTE_EPSAJ).Value = CDbl(inhalt)
End If
End If
If spalteLJ > 3 Then
inhalt = MeinSystemFormat(shQ.Cells(zeileEPS, spalteLJ - 2).Value)
If IsNumeric(inhalt) Then
sh.Cells(zeile, SPALTE_EPSNJ).Value = CDbl(inhalt)
End If
End If
'Die Nullen von rechts entfernen - Schwäche von OnVista - bei EPS steht oftmals 0, _
wenn kein Wert bekannt bzw. geschätzt ist.
'Die Wahrscheinlichkeit, dass 0 hier korrekt wäre, ist sehr klein.
For K = SPALTE_EPSNJ To SPALTE_EPSLJ2 Step -1
If IsNumeric(sh.Cells(zeile, K).Value) Then
If sh.Cells(zeile, K).Value = 0 Then
sh.Cells(zeile, K).Value = ""
Else
Exit For
End If
End If
Next
'KGV:
inhalt = MeinSystemFormat(shQ.Cells(zeileKGV, spalteLJ + 2).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_KGVLJ2).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_KGVLJ2).Value = shVorher.Cells(zeileVorher, _
SPALTE_KGVLJ2).Value
End If
End If
inhalt = MeinSystemFormat(shQ.Cells(zeileKGV, spalteLJ + 1).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_KGVLJ1).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_KGVLJ1).Value = shVorher.Cells(zeileVorher, _
SPALTE_KGVLJ1).Value
End If
End If
inhalt = MeinSystemFormat(shQ.Cells(zeileKGV, spalteLJ).Value)
If IsNumeric(inhalt) And (inhalt "") Then
sh.Cells(zeile, SPALTE_KGVLJ).Value = CDbl(inhalt)
Else
If gleichesLJ Then
'übernehmen evt. manuell eingepflegten Wert aus der vorigen Bewertung
sh.Cells(zeile, SPALTE_KGVLJ).Value = shVorher.Cells(zeileVorher, _
SPALTE_KGVLJ).Value
End If
End If
If spalteLJ > 2 Then
inhalt = MeinSystemFormat(shQ.Cells(zeileKGV, spalteLJ - 1).Value)
If IsNumeric(inhalt) Then
sh.Cells(zeile, SPALTE_KGVAJ).Value = CDbl(inhalt)
End If
End If
End If
End If
End Function
Function AnalystenMeinungen(isin As String, zeile As Long, quellZeile As Long, shA As Worksheet, _
shQ As Worksheet, qt As QueryTable, sh As Worksheet)
'Holt die Anzahl der Analysten und deren Meinung, trägt sie ins Ziel-Bewertungsblatt in die _
Zeile zur ISIN ein.
'benutzt dazu de.4-traders.com
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Const URL_ANFANG = "URL;http://de.4-traders.com/"
Const URL_ENDE = "analystenerwartungen/"
Dim urlTeil As String
Dim url As String
Dim rng As Range
Dim Z As Long
Dim S As Long
Dim inhalt As String
Dim ergebnis As Integer
Dim anzahl As Integer
sh.Cells(zeile, SPALTE_ANALYSTENANZAHL).Value = ""
sh.Cells(zeile, SPALTE_ANALYSTENMEINUNG).Value = ""
'Internet-Seite laden
urlTeil = shA.Cells(quellZeile, SPALTE_4TRADERS).Value 'URL-Teil für 4-traders
If urlTeil = "" Then
Exit Function
End If
url = URL_ANFANG + urlTeil + URL_ENDE
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'Daten extrahieren und ins Ziel-Bewertungsblatt eintragen
sh.Cells(zeile, SPALTE_ANALYSTENANZAHL).Value = 0
Set rng = shQ.Cells.Find("Durchschnittl. Empfehlung", shQ.Cells(1, 1))
If Not rng Is Nothing Then
Z = rng.Row
S = rng.Column + 1
inhalt = CStr(shQ.Cells(Z, S).Value)
Select Case inhalt
Case "KAUFEN": ergebnis = 1
Case "AUFSTOCKEN": ergebnis = 2
Case "HALTEN": ergebnis = 3
Case "REDUZIEREN": ergebnis = 4
Case "VERKAUFEN": ergebnis = 5
End Select
If ergebnis > 0 Then
sh.Cells(zeile, SPALTE_ANALYSTENMEINUNG).Value = ergebnis
inhalt = CStr(shQ.Cells(Z + 1, S).Value)
If IsNumeric(inhalt) Then
anzahl = CInt(inhalt)
sh.Cells(zeile, SPALTE_ANALYSTENANZAHL).Value = anzahl
End If
End If
End If
End Function
Function Marktkapitalisierung(isin As String, zeile As Long, quellZeile, shA As Worksheet, shQ _
As Worksheet, qt As QueryTable, sh As Worksheet)
'Holt die aktuelle Marktkapitalisierung, trägt sie ins Ziel-Bewertungsblatt in die Zeile _
zur ISIN ein.
'benutzt dazu finanzen.net
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Const URL_ANFANG = "URL;http://www.finanzen.net/aktien/"
Dim urlTeil As String
Dim url As String
Dim rng As Range
Dim K As Integer
sh.Cells(zeile, SPALTE_MARKTKAP).Value = ""
'Seite aus dem Web abrufen:
urlTeil = shA.Cells(quellZeile, SPALTE_FINANZEN_NET).Value
If urlTeil = "" Then
Exit Function
End If
url = URL_ANFANG + urlTeil
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'Marktkapitalisierung auslesen und in Bewertungsblatt eintragen:
Set rng = shQ.Cells.Find("Marktkapitalisierung (EUR)", shQ.Cells(1, 1))
If Not rng Is Nothing Then
For K = 1 To 5
If CStr(shQ.Cells(rng.Row, rng.Column + K).Value) Like "* M?." Then
sh.Cells(zeile, SPALTE_MARKTKAP).Value = shQ.Cells(rng.Row, rng.Column + K). _
Value
Exit For
End If
Next
End If
End Function
Function Quartalszahlen(isin As String, zeile As Long, quellZeile As Long, shA As Worksheet, _
shQ As Worksheet, qt As QueryTable, sh As Worksheet, shVorher As Worksheet, zeileVorher As Long)
'Ermittelt das Datum der letzten Zahlen, sowie die entsprechenden historischen Kurse der _
Aktie und der Benchmark (Vergleichsindex)
'benutzt dazu finanzen.net (Datum der letzten Zahlen), yahoo.de bzw. onvista.de zur _
Ermittlung der historischen Kurse
'wenn das Datum der letzten Zahlen seit der vorigen Bewertung unverändert ist, werden die _
dazugehörigen Zahlen aus der vorigen Bewertung überträgen (spart Web-Zugriffe)
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
' shVorher voriges Bewertungsblatt
' zeileVorher Zeile dieser Aktie im vorigen Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Dim urlTeil As String
Dim url As String
Dim rng As Range
Dim zeileTermine As Long
Dim zeileDatum As Long
Dim datum As Variant
Dim DatumVortag As Variant
Dim datumWeb As Variant
Dim inhalt As String
Dim heute As Variant
Dim datumStamm As Variant
Dim K As Long
Dim idOnvista As String
Dim datumKurs As Variant
Dim datumKursVortag As Variant
Dim datumKursB As Variant
Dim datumKursVortagB As Variant
Dim tickerB As String
Dim idBOnvista As String
Dim gleichesDatum As Boolean
Dim gleicheBenchmark As Boolean
Const URL_ANFANG = "URL;http://www.finanzen.net/termine/"
sh.Cells(zeile, SPALTE_BENCHMARK).Value = ""
sh.Cells(zeile, SPALTE_DATUMZAHLEN).Value = ""
sh.Cells(zeile, SPALTE_DATUMVORTAG).Value = ""
sh.Cells(zeile, SPALTE_KURSZAHLEN).Value = ""
sh.Cells(zeile, SPALTE_KURSVORTAG).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARKKURS).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARKVORTAG).Value = ""
'Datum der letzten Zahlen herausfinden
'von der Web-Seite
urlTeil = shA.Cells(quellZeile, SPALTE_FINANZEN_NET).Value 'finanzen.net
If urlTeil = "" Then
Exit Function
End If
url = URL_ANFANG + urlTeil
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'Termin der letzten Zahlen extrahieren
datumWeb = Empty
Set rng = shQ.Cells.Find("Terminart", shQ.Cells(1, 1))
If Not rng Is Nothing Then
zeileTermine = rng.Row
For K = 1 To 15
If (shQ.Cells(zeileTermine + K, 1) = "Quartalszahlen") Or (shQ.Cells(zeileTermine + _
K, 1).Value = "Jahresabschluss") Then
zeileDatum = zeileTermine + K
inhalt = CStr(shQ.Cells(zeileDatum, 3).Value)
datumWeb = DatumsWert(inhalt)
Exit For
End If
Next
End If
'aus den Stammdaten (Tabellenblatt "Aktien")
datumStamm = Empty
heute = DateValue(Now) 'DateValue ist OK, weil Now vom System kommt
K = SPALTE_TERMINE
Do Until CStr(shA.Cells(quellZeile, K).Value) = ""
datum = shA.Cells(quellZeile, K).Value
If TypeName(datum) "Date" Then
datum = Empty
End If
If Not IsEmpty(datum) Then
If datum > heute Then Exit Do
datumStamm = datum
End If
K = K + 1
Loop
datum = datumWeb
If IsEmpty(datum) Then
'kein Datum im Web gefunden
datum = datumStamm
Else
If Not IsEmpty(datumStamm) Then
If datumStamm > datum Then
datum = datumStamm
End If
End If
End If
'Historische Kurse zum (Quartalszahlen-)Datum und Vortag für Aktie und Benchmark ermitteln:
'Benchmark und QZ-Datum eintragen:
sh.Cells(zeile, SPALTE_BENCHMARK).Value = shA.Cells(quellZeile, SPALTE_BENCHMARK_NAME). _
Value
If Not IsEmpty(datum) Then
sh.Cells(zeile, SPALTE_DATUMZAHLEN).Value = datum
gleichesDatum = False
gleicheBenchmark = False
If zeileVorher > 1 Then
If CStr(shVorher.Cells(zeileVorher, SPALTE_DATUMZAHLEN).Value) = CStr(datum) Then
gleichesDatum = True
End If
End If
'Historische Kurse für das QZ-Datum und den Vortag:
urlTeil = shA.Cells(quellZeile, SPALTE_YAHOO).Value 'für yahoo.de
idOnvista = shA.Cells(quellZeile, SPALTE_HIST_ONVISTA).Value 'für die historische _
Kursabfrage bei onvista
If gleichesDatum Then
'aus dem vorigen Bewertungsblatt übernehmen
sh.Cells(zeile, SPALTE_DATUMZAHLEN).Value = shVorher.Cells(zeileVorher, _
SPALTE_DATUMZAHLEN).Value
sh.Cells(zeile, SPALTE_KURSZAHLEN).Value = shVorher.Cells(zeileVorher, _
SPALTE_KURSZAHLEN).Value
sh.Cells(zeile, SPALTE_DATUMVORTAG).Value = shVorher.Cells(zeileVorher, _
SPALTE_DATUMVORTAG).Value
sh.Cells(zeile, SPALTE_KURSVORTAG).Value = shVorher.Cells(zeileVorher, _
SPALTE_KURSVORTAG).Value
Else
'aktuell aus dem Web holen
If (urlTeil = "") And (idOnvista = "") Then
Exit Function
End If
datumKurs = DatumKursHistorisch(urlTeil, idOnvista, CDate(datum), shQ, qt)
If datumKurs(0) "" Then
datum = DatumsWert(datumKurs(0))
sh.Cells(zeile, SPALTE_DATUMZAHLEN).Value = datum
If IsNumeric(datumKurs(1)) Then
sh.Cells(zeile, SPALTE_KURSZAHLEN).Value = CDbl(datumKurs(1))
End If
End If
'Vortag:
If datumKurs(0) "" Then
DatumVortag = DateAdd("d", -1, datum)
datumKursVortag = DatumKursHistorisch(urlTeil, idOnvista, CDate(DatumVortag), _
shQ, qt)
If datumKursVortag(0) "" Then
DatumVortag = DatumsWert(datumKursVortag(0))
sh.Cells(zeile, SPALTE_DATUMVORTAG).Value = DatumVortag
If IsNumeric(datumKursVortag(1)) Then
sh.Cells(zeile, SPALTE_KURSVORTAG).Value = CDbl(datumKursVortag(1))
End If
End If
End If
End If
'Benchmark:
tickerB = shA.Cells(quellZeile, SPALTE_BENCHMARK_YAHOO).Value
idBOnvista = shA.Cells(quellZeile, SPALTE_BENCHMARK_HIST_ONVISTA).Value
If gleichesDatum Then
If CStr(sh.Cells(zeile, SPALTE_BENCHMARK).Value) = CStr(shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARK).Value) Then
gleicheBenchmark = True
End If
End If
If gleicheBenchmark Then
'auch für die Benchmark aus dem vorigen Tabellenblatt übernehmen
sh.Cells(zeile, SPALTE_BENCHMARKKURS).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARKKURS).Value
sh.Cells(zeile, SPALTE_BENCHMARKVORTAG).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARKVORTAG).Value
Else
'aktuell aus dem Web holen
If (tickerB = "") And (idBOnvista = "") Then
Exit Function
End If
datumKursB = DatumKursHistorisch(tickerB, idBOnvista, CDate(datum), shQ, qt)
If datumKursB(0) "" Then
If datumKursB(0) = Format(sh.Cells(zeile, SPALTE_DATUMZAHLEN).Value, "yyyy-mm- _
dd") Then
If IsNumeric(datumKursB(1)) Then
sh.Cells(zeile, SPALTE_BENCHMARKKURS).Value = CDbl(datumKursB(1))
End If
End If
End If
'Benchmark Vortag:
If CStr(sh.Cells(zeile, SPALTE_DATUMVORTAG).Value) "" Then
datumKursVortagB = DatumKursHistorisch(tickerB, idBOnvista, sh.Cells(zeile, _
SPALTE_DATUMVORTAG).Value, shQ, qt)
If datumKursVortagB(0) = Format(sh.Cells(zeile, SPALTE_DATUMVORTAG).Value, " _
yyyy-mm-dd") Then
If IsNumeric(datumKursVortagB(1)) Then
sh.Cells(zeile, SPALTE_BENCHMARKVORTAG).Value = CDbl(datumKursVortagB(1) _
)
End If
End If
End If
End If
End If
End Function
Function GewinnRevisionen(isin As String, zeile As Long, sh As Worksheet, shVorher As Worksheet, _
zeileVorher As Long)
'Übertragt die geschätzten EPS-Werte für das aktuelle und das nächste Jahr aus der vorigen _
Bewertung in diese Ziel-Bewertung
'Parameter: isin es geht um die Aktie mit dieser ISIN
' zeile Zeilennummer der Aktie im aktuellen Bewertungsblatt
' sh aktuelles Bewertungsblatt
' shVorher voriges Bewertungsblatt
' zeileVorher Zeile dieser Aktie im vorigen Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Dim K As Integer
For K = 4 To 1 Step -1
sh.Cells(zeile, SPALTE_EPSAJ_WDH - K).Value = ""
sh.Cells(zeile, SPALTE_EPSNJ_WDH - K).Value = ""
Next
If zeileVorher > 1 Then
'EPS-Daten übertragen:
If CStr(sh.Cells(zeile, SPALTE_LJ).Value) = CStr(shVorher.Cells(zeileVorher, SPALTE_LJ). _
Value) Then
'kein Geschäftsjahreswechsel
For K = 4 To 1 Step -1
sh.Cells(zeile, SPALTE_EPSAJ_WDH - K).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSAJ_WDH - K + 1).Value
sh.Cells(zeile, SPALTE_EPSNJ_WDH - K).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSNJ_WDH - K + 1).Value
Next
Else
'Geschäftsjahreswechsel - aus den Schätzungen für das nächste Jahr werden nun Schä _
tzungen für das aktuelle Jahr
For K = 4 To 1 Step -1
sh.Cells(zeile, SPALTE_EPSAJ_WDH - K).Value = shVorher.Cells(zeileVorher, _
SPALTE_EPSNJ_WDH - K + 1).Value
Next
End If
End If
End Function
Function HistorischeKurse(isin As String, zeile As Long, quellZeile As Long, shA As Worksheet, _
shQ As Worksheet, qt As QueryTable, sh As Worksheet)
'Ermittelt jeweils Datum und Kurs der Aktie von vor 6 Monaten bzw. 1 Jahr.
'benutzt yahoo.de bzw. onvista.de
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Dim urlTeil As String
Dim idOnvista As String
Dim inhalt As String
Dim datum As Date
Dim DatumHist As Date
Dim datumKurs As Variant
sh.Cells(zeile, SPALTE_DATUM6MON).Value = ""
sh.Cells(zeile, SPALTE_KURS6MON).Value = ""
sh.Cells(zeile, SPALTE_DATUM1JAHR).Value = ""
sh.Cells(zeile, SPALTE_KURS1JAHR).Value = ""
urlTeil = shA.Cells(quellZeile, SPALTE_YAHOO).Value
idOnvista = shA.Cells(quellZeile, SPALTE_HIST_ONVISTA).Value
If (urlTeil = "") And (idOnvista = "") Then
Exit Function
End If
inhalt = CStr(sh.Cells(zeile, SPALTE_DATUM).Value)
If inhalt = "" Then
Exit Function
End If
datum = CDate(inhalt)
'vor 6 Monaten:
DatumHist = DateAdd("m", -6, datum)
datumKurs = DatumKursHistorisch(urlTeil, idOnvista, DatumHist, shQ, qt)
If datumKurs(0) "" Then
sh.Cells(zeile, SPALTE_DATUM6MON).Value = DatumsWert(datumKurs(0))
If IsNumeric(datumKurs(1)) Then
sh.Cells(zeile, SPALTE_KURS6MON).Value = CDbl(datumKurs(1))
End If
End If
'vor 1 Jahr:
DatumHist = DateAdd("yyyy", -1, datum)
datumKurs = DatumKursHistorisch(urlTeil, idOnvista, DatumHist, shQ, qt)
If datumKurs(0) "" Then
sh.Cells(zeile, SPALTE_DATUM1JAHR).Value = DatumsWert(datumKurs(0))
If IsNumeric(datumKurs(1)) Then
sh.Cells(zeile, SPALTE_KURS1JAHR).Value = CDbl(datumKurs(1))
End If
End If
End Function
Function DreiMonatsReversal(isin As String, zeile As Long, quellZeile As Long, shA As Worksheet, _
shQ As Worksheet, qt As QueryTable, sh As Worksheet, shVorher As Worksheet, zeileVorher As Long)
'Ermittelt für Aktie und Benchmark die Schlusskurse der letzten vier Monate, damit danach _
die letzten drei Monatsentwicklungen verglichen werden können.
'nur für Large Caps
'benutzt yahoo.de bzw. onvista.de
'wenn sich nichts geändert hat (Datum, Benchmark), werden die Daten aus der vorigen _
Bewertung übernommen
'Parameter: isin zu dieser ISIN werden die Daten geholt
' zeile in diese Zeile des Bewertungsblattes werden die Daten geschrieben
' quellZeile in dieser Zeile des Tabellenblattes "Aktien" stehen benötigte _
Hilfsdaten zur Aktie (URL-Teile für die Abfragen usw.)
' shA Tabellenblatt "Aktien"
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
' sh Ziel-Bewertungsblatt
' shVorher Tabellenblatt zur vorigen Bewertung
' zeileVorher Zeile dieser Aktie in der vorigen Bewertung
'wird verwendet in DatenZurISINHolen
Dim ticker As String
Dim idOnvista As String
Dim tickerB As String
Dim idBOnvista As String
Dim datum As Date
Dim datumKurs0 As Variant
Dim datumKurs1 As Variant
Dim datumKurs2 As Variant
Dim datumKurs3 As Variant
Dim K As Integer
Dim datumKursB0 As Variant
Dim datumKursB1 As Variant
Dim datumKursB2 As Variant
Dim datumKursB3 As Variant
Dim gleicheMon As Boolean
Dim gleicheBenchmark As Boolean
Dim datumVorher As Variant
sh.Cells(zeile, SPALTE_DATUM3MON).Value = ""
sh.Cells(zeile, SPALTE_KURS3MON).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARK3MON).Value = ""
sh.Cells(zeile, SPALTE_DATUM2MON).Value = ""
sh.Cells(zeile, SPALTE_KURS2MON).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARK2MON).Value = ""
sh.Cells(zeile, SPALTE_DATUM1MON).Value = ""
sh.Cells(zeile, SPALTE_KURS1MON).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARK1MON).Value = ""
sh.Cells(zeile, SPALTE_DATUM0MON).Value = ""
sh.Cells(zeile, SPALTE_KURS0MON).Value = ""
sh.Cells(zeile, SPALTE_BENCHMARK0MON).Value = ""
'nur für Large Caps:
If CStr(sh.Cells(zeile, SPALTE_GROESSE).Value) "L" Then
Exit Function
End If
'Symbole für historische Kursabfrage bei Yahoo bzw. OnVista:
ticker = CStr(shA.Cells(quellZeile, SPALTE_YAHOO).Value)
idOnvista = CStr(shA.Cells(quellZeile, SPALTE_HIST_ONVISTA).Value)
tickerB = CStr(shA.Cells(quellZeile, SPALTE_BENCHMARK_YAHOO).Value)
idBOnvista = CStr(shA.Cells(quellZeile, SPALTE_BENCHMARK_HIST_ONVISTA).Value)
'letztes Monatsende vor bzw. zum Kursdatum ermitteln, Kurs der Aktie am letzten Börsentag _
dazu abfragen
If CStr(sh.Cells(zeile, SPALTE_DATUM).Value) = "" Then
Exit Function
End If
datum = CDate(CStr(sh.Cells(zeile, SPALTE_DATUM).Value))
datum = DateAdd("d", 1, datum)
datum = CDate(DatumsWert("01." + Right("0" + CStr(Month(datum)), 2) + "." + CStr(Year(datum) _
)))
datum = DateAdd("d", -1, datum)
'nachsehen, ob das beim letzten Lauf schon genauso ausgewertet wurde
gleicheMon = False
gleicheBenchmark = False
If zeileVorher > 1 Then
If CStr(shVorher.Cells(zeileVorher, SPALTE_GROESSE).Value) = "L" Then
datumVorher = shVorher.Cells(zeileVorher, SPALTE_DATUM0MON).Value
If CStr(datumVorher) "" Then
If IsDate(datumVorher) Then
If (Year(datumVorher) = Year(datum)) And (Month(datumVorher) = Month(datum)) _
Then
gleicheMon = True
End If
End If
End If
End If
End If
If gleicheMon Then
'Datum und Kurs der Aktie zu den Monatsenden eintragen - aus dem vorigen Blatt
sh.Cells(zeile, SPALTE_DATUM3MON).Value = shVorher.Cells(zeileVorher, SPALTE_DATUM3MON). _
Value
sh.Cells(zeile, SPALTE_KURS3MON).Value = shVorher.Cells(zeileVorher, SPALTE_KURS3MON). _
Value
sh.Cells(zeile, SPALTE_DATUM2MON).Value = shVorher.Cells(zeileVorher, SPALTE_DATUM2MON). _
Value
sh.Cells(zeile, SPALTE_KURS2MON).Value = shVorher.Cells(zeileVorher, SPALTE_KURS2MON). _
Value
sh.Cells(zeile, SPALTE_DATUM1MON).Value = shVorher.Cells(zeileVorher, SPALTE_DATUM1MON). _
Value
sh.Cells(zeile, SPALTE_KURS1MON).Value = shVorher.Cells(zeileVorher, SPALTE_KURS1MON). _
Value
sh.Cells(zeile, SPALTE_DATUM0MON).Value = shVorher.Cells(zeileVorher, SPALTE_DATUM0MON). _
Value
sh.Cells(zeile, SPALTE_KURS0MON).Value = shVorher.Cells(zeileVorher, SPALTE_KURS0MON). _
Value
Else
'Daten aus dem Web holen
If ((ticker = "") And (idOnvista = "")) Or ((tickerB = "") And (idBOnvista = "")) Then
Exit Function
End If
datumKurs0 = DatumKursHistorisch(ticker, idOnvista, datum, shQ, qt)
If (datumKurs0(0) = "") Or (datumKurs0(1) = "") Then
Exit Function
End If
'Monatsende und Kurs einen Monat weiter zurück ermitteln:
datum = CDate(DatumsWert(datumKurs0(0)))
datum = CDate(DatumsWert("01." + Right("0" + CStr(Month(datum)), 2) + "." + CStr(Year( _
datum))))
datum = DateAdd("d", -1, datum)
datumKurs1 = DatumKursHistorisch(ticker, idOnvista, datum, shQ, qt)
If (datumKurs1(0) = "") Or (datumKurs1(1) = "") Then
Exit Function
End If
'Monatsende und Kurs zwei Monate weiter zurück ermitteln:
datum = CDate(DatumsWert(datumKurs1(0)))
datum = CDate(DatumsWert("01." + Right("0" + CStr(Month(datum)), 2) + "." + CStr(Year( _
datum))))
datum = DateAdd("d", -1, datum)
datumKurs2 = DatumKursHistorisch(ticker, idOnvista, datum, shQ, qt)
If (datumKurs2(0) = "") Or (datumKurs2(1) = "") Then
Exit Function
End If
'Monatsende und Kurs drei Monate weiter zurück ermitteln:
datum = CDate(DatumsWert(datumKurs2(0)))
datum = CDate(DatumsWert("01." + Right("0" + CStr(Month(datum)), 2) + "." + CStr(Year( _
datum))))
datum = DateAdd("d", -1, datum)
datumKurs3 = DatumKursHistorisch(ticker, idOnvista, datum, shQ, qt)
If (datumKurs3(0) = "") Or (datumKurs3(1) = "") Then
Exit Function
End If
'Datum und Kurs der Aktie zu den Monatsenden eintragen
sh.Cells(zeile, SPALTE_DATUM3MON).Value = DatumsWert(datumKurs3(0))
sh.Cells(zeile, SPALTE_KURS3MON).Value = CDbl(datumKurs3(1))
sh.Cells(zeile, SPALTE_DATUM2MON).Value = DatumsWert(datumKurs2(0))
sh.Cells(zeile, SPALTE_KURS2MON).Value = CDbl(datumKurs2(1))
sh.Cells(zeile, SPALTE_DATUM1MON).Value = DatumsWert(datumKurs1(0))
sh.Cells(zeile, SPALTE_KURS1MON).Value = CDbl(datumKurs1(1))
sh.Cells(zeile, SPALTE_DATUM0MON).Value = DatumsWert(datumKurs0(0))
sh.Cells(zeile, SPALTE_KURS0MON).Value = CDbl(datumKurs0(1))
End If
'Kurse für die Benchmark am Monatsende könnten schon für eine der Aktien davor geholt _
worden sein:
For K = zeile - 1 To 2 Step -1
If (CStr(sh.Cells(K, SPALTE_GROESSE).Value) = "L") And (CStr(sh.Cells(K, _
SPALTE_BENCHMARK).Value) = CStr(shA.Cells(quellZeile, SPALTE_BENCHMARK_NAME).Value)) Then
If IsDate(sh.Cells(K, SPALTE_DATUM0MON).Value) Then
If CStr(sh.Cells(K, SPALTE_DATUM0MON).Value) = CStr(sh.Cells(zeile, _
SPALTE_DATUM0MON).Value) Then
'Kurse für die Benchmark können aus dieser Zeile übertragen werden:
sh.Cells(zeile, SPALTE_BENCHMARK3MON).Value = sh.Cells(K, _
SPALTE_BENCHMARK3MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK2MON).Value = sh.Cells(K, _
SPALTE_BENCHMARK2MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK1MON).Value = sh.Cells(K, _
SPALTE_BENCHMARK1MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK0MON).Value = sh.Cells(K, _
SPALTE_BENCHMARK0MON).Value
Exit Function
End If
End If
End If
Next
'schauen, ob die Kurse für die Benchmark vom vorigen Bewertungsblatt geholt werden können
If gleicheMon Then
If CStr(shVorher.Cells(zeileVorher, SPALTE_BENCHMARK).Value) = CStr(shA.Cells( _
quellZeile, SPALTE_BENCHMARK_NAME).Value) Then
gleicheBenchmark = True
End If
End If
If gleicheBenchmark Then
'Benchmark-Vergleichskurs vom vorigen Bewertungsblatt holen
sh.Cells(zeile, SPALTE_BENCHMARK3MON).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARK3MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK2MON).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARK2MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK1MON).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARK1MON).Value
sh.Cells(zeile, SPALTE_BENCHMARK0MON).Value = shVorher.Cells(zeileVorher, _
SPALTE_BENCHMARK0MON).Value
Else
'Kurse für die Benchmark müssen aus dem Internet geladen werden:
If CStr(sh.Cells(zeile, SPALTE_DATUM0MON).Value) "" Then
datumKursB0 = DatumKursHistorisch(tickerB, idBOnvista, sh.Cells(zeile, _
SPALTE_DATUM0MON).Value, shQ, qt)
If (datumKursB0(0) Format(sh.Cells(zeile, SPALTE_DATUM0MON).Value, "yyyy-mm-dd")) _
Or (datumKursB0(1) = "") Then
Exit Function
End If
sh.Cells(zeile, SPALTE_BENCHMARK0MON).Value = CDbl(datumKursB0(1))
End If
If CStr(sh.Cells(zeile, SPALTE_DATUM1MON).Value) "" Then
datumKursB1 = DatumKursHistorisch(tickerB, idBOnvista, sh.Cells(zeile, _
SPALTE_DATUM1MON).Value, shQ, qt)
If (datumKursB1(0) Format(sh.Cells(zeile, SPALTE_DATUM1MON).Value, "yyyy-mm-dd")) _
Or (datumKursB1(1) = "") Then
Exit Function
End If
sh.Cells(zeile, SPALTE_BENCHMARK1MON).Value = CDbl(datumKursB1(1))
End If
If CStr(sh.Cells(zeile, SPALTE_DATUM2MON).Value) "" Then
datumKursB2 = DatumKursHistorisch(tickerB, idBOnvista, sh.Cells(zeile, _
SPALTE_DATUM2MON).Value, shQ, qt)
If (datumKursB2(0) Format(sh.Cells(zeile, SPALTE_DATUM2MON).Value, "yyyy-mm-dd")) _
Or (datumKursB2(1) = "") Then
Exit Function
End If
sh.Cells(zeile, SPALTE_BENCHMARK2MON).Value = CDbl(datumKursB2(1))
End If
If CStr(sh.Cells(zeile, SPALTE_DATUM3MON).Value) "" Then
datumKursB3 = DatumKursHistorisch(tickerB, idBOnvista, sh.Cells(zeile, _
SPALTE_DATUM3MON).Value, shQ, qt)
If (datumKursB3(0) Format(sh.Cells(zeile, SPALTE_DATUM3MON).Value, "yyyy-mm-dd")) _
Or (datumKursB3(1) = "") Then
Exit Function
End If
sh.Cells(zeile, SPALTE_BENCHMARK3MON).Value = CDbl(datumKursB3(1))
End If
End If
End Function
Function Bemerkungen(isin As String, zeile As Long, sh As Worksheet, shVorher As Worksheet, _
zeileVorher As Long)
'Übertragt die Bemerkungen soweit vorhanden aus dem vorigen Blatt ins aktuelle mit _
davorstehendem Datum, um zu zeigen, aus welcher Bewertung diese stammen
'Parameter: isin es geht um die Aktie mit dieser ISIN
' zeile Zeilennummer der Aktie im aktuellen Bewertungsblatt
' sh aktuelles Bewertungsblatt
' shVorher voriges Bewertungsblatt
' zeileVorher Zeile dieser Aktie im vorigen Bewertungsblatt
'wird verwendet in DatenZurISINHolen
Dim bemerkung As String
sh.Cells(zeile, SPALTE_BEMERKUNGEN).Value = ""
If zeileVorher > 1 Then
bemerkung = CStr(shVorher.Cells(zeileVorher, SPALTE_BEMERKUNGEN).Value)
If bemerkung "" Then
If bemerkung Like "####-##-##: *" Then
sh.Cells(zeile, SPALTE_BEMERKUNGEN).Value = bemerkung
Else
sh.Cells(zeile, SPALTE_BEMERKUNGEN).Value = shVorher.Name + ": " + bemerkung
End If
End If
End If
End Function
Function DatumKursHistorisch(idYahoo As String, idOnvista As String, datum As Date, shQ As _
Worksheet, qt As QueryTable) As Variant
'Holt zu einer Aktie und einem Datum den letzten Kurs zu bzw vor diesem Datum. (Vor diesem _
Datum, falls das kein Börsentag war.)
'Versucht bei OnVista die Daten zu holen. Wenn das nicht möglich ist, bei Yahoo.
'Parameter: idYahoo Yahoo-Tickersymbol zum Auffinden der Aktie bei Yahoo
' idOnVista OnVista-Id zum Auffinden in der historischen Kursabfrage bei _
OnVista
' datum an bzw. vor diesem Datum soll der Kurs ermittelt werden
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das _
Auslesen der Daten benutzt
'Rückgabewert: String-Array der Länge 2: bei Index 0 steht das Datum, bei Index 1 steht _
der Kurs
'wird verwendet in
' Quartalszahlen
' HistorischeKurse
' DreiMonatsReversal
Dim datumKurs As Variant
ReDim datumKurs(1) As String
If idOnvista "" Then
datumKurs = DatumKursVonOnvista(idOnvista, datum, shQ, qt)
End If
If (datumKurs(0) = "") Or (datumKurs(1) = "") Then
If idYahoo "" Then
datumKurs = DatumKursVonYahoo(idYahoo, datum, shQ, qt, keinYahoo)
End If
End If
DatumKursHistorisch = datumKurs
End Function
Function DatumKursVonYahoo(ticker As String, datum As Date, shQ As Worksheet, qt As QueryTable, _
keinYahoo As Boolean) As Variant
'Holt zu einer Aktie und einem Datum den letzten Kurs zu bzw vor diesem Datum. (Vor diesem _
Datum, falls das kein Börsentag war.)
'Verwendet dazu Yahoo.
'Parameter: ticker Yahoo-Tickersymbol zum Auffinden der Aktie
' Datum an bzw. vor diesem Datum soll der Kurs ermittelt werden
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das _
Auslesen der Daten benutzt
' keinYahoo True, wenn Zugriff auf Yahoo vorher verweigert wurde
'Rückgabewert: String-Array der Länge 2: bei Index 0 steht das Datum, bei Index 1 steht _
der Kurs
'wird verwendet in
' DatumKursHistorisch
Dim datumKurs(1) As String
Dim p As Variant
Dim url As String
Dim V As Variant
Dim inhalt As String
Dim kursDatum As Date
If keinYahoo Then GoTo ende
p = DatumAlsYahooParameter(ticker, datum)
url = "URL;http://ichart.finance.yahoo.com/table.csv?s=" + p(0) + "&b=" + p(1) + "&a=" + p(2) + _
"&c=" + p(3) + "&e=" + p(4) + "&d=" + p(5) + "&f=" + p(6) + "&g=d"
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
On Error GoTo keinZugriff
.Refresh (False)
On Error GoTo 0
End With
'Datum und Kurs auslesen
V = Split(CStr(shQ.Cells(2, 1).Value), ",")
If UBound(V) >= 6 Then
inhalt = V(0)
If inhalt Like "####-##-##" Then
kursDatum = CDate(DatumsWert(inhalt))
If kursDatum
Function DatumAlsYahooParameter(ticker As String, datum As Date) As Variant
'Erzeugt aus einem Yahoo-Tickersymbol und einem Datum URL-Parameter für die Kursabfrage bei _
Yahoo.
'Rückgabewert: String-Array der Länge 7 spezielle für die Verwendung als Teile einer Yahoo- _
URL
'wird verwendet in DatumKursVonYahoo
Dim datumVonBis(6) As String
Dim datumVon As Date
datumVonBis(0) = ticker
datumVon = DateAdd("d", -7, datum)
datumVonBis(1) = CStr(Day(datumVon))
datumVonBis(2) = Right(CStr(Month(datumVon) - 1 + 100), 2)
datumVonBis(3) = CStr(Year(datumVon))
datumVonBis(4) = CStr(Day(datum))
datumVonBis(5) = Right(CStr(Month(datum) - 1 + 100), 2)
datumVonBis(6) = CStr(Year(datum))
DatumAlsYahooParameter = datumVonBis
End Function
Function DatumKursVonOnvista(id As String, datum As Date, shQ As Worksheet, qt As QueryTable) _
As Variant
'Holt zu einer Aktie und einem Datum den letzten Kurs zu bzw vor diesem Datum. (Vor diesem _
Datum, falls das kein Börsentag war.)
'Verwendet dazu OnVista.
'Parameter: id interne OnVista-Id zum Auffinden der Aktie
' Datum an bzw. vor diesem Datum soll der Kurs ermittelt werden
' shQ Tabellenblatt "Query" - Hilfsblatt für die Web-Abfragen
' qt QueryTable - Hilfs-Tabelle zur Web-Abfrage, wird für das Auslesen _
der Daten benutzt
'Rückgabewert: String-Array der Länge 2: bei Index 0 steht das Datum, bei Index 1 steht _
der Kurs
'wird verwendet in
' DatumKursHistorisch
Dim datumKurs(1) As String
Dim datumVon As Date
Dim url As String
Dim K As Integer
Dim inhalt As String
Dim V As Variant
Dim datumStr As String
Dim kursDatum As Date
Dim testDatum As Variant
'Web-Abfrage - Kurse um das gewünschte Datum herum (ab 14 Tage zurück für einen Monat):
datumVon = DateAdd("d", -14, datum)
url = "URL;http://www.onvista.de/onvista/boxes/historicalquote/export.csv?notationId=" + id + "& _
dateStart=" + Format(datumVon, "dd.mm.yyyy") + "&interval=M1"
shQ.Cells.NumberFormat = "@"
With qt
.Connection = url
.Refresh (False)
End With
'Datum und Kurs heraussuchen:
For K = 30 To 2 Step -1
inhalt = CStr(shQ.Cells(K, 1).Value)
If inhalt "" Then
V = Split(inhalt, ";")
datumStr = Trim(V(0))
If UBound(V) >= 4 Then
testDatum = DatumsWert(datumStr)
If Not IsEmpty(testDatum) Then
kursDatum = CDate(testDatum)
If kursDatum
Function DatumsWert(wert As Variant) As Variant
'Versucht, den Wert wert in einen Datumswert umzuwandeln. Das ist unabhängig vom _
Datumsformat des Systems
'Wenn das nicht klappt, wird Empty zurückgegeben
'Ansonsten wird ein Wert vom Typ Date zurückgegeben.
Dim wertS As String
Dim V As Variant
wertS = CStr(wert)
If (wertS Like "##.##.####") Or (wertS Like "##.##.##") Then 'dd.mm.yyyy oder dd.mm.yy _
im 21. Jh.
V = Split(wertS, ".")
If Len(V(2)) = 2 Then
V(2) = "20" + V(2)
End If
DatumsWert = DateSerial(V(2), V(1), V(0))
Exit Function
End If
If (wertS Like "####-##-##") Or (wertS Like "##-##-##") Then 'yyyy-mm-dd oder yy-mm-dd _
im 21. Jh.
V = Split(wertS, "-")
If Len(V(0)) = 2 Then
V(0) = "20" + V(0)
End If
DatumsWert = DateSerial(V(0), V(1), V(2))
Exit Function
End If
DatumsWert = Empty
End Function
Function MeinSystemFormat(wert As Variant) As String
'Wandeln wert (deutsches Zahlenformat) in einen String um mit zum System passenden Dezimal- _
bzw. Tausendertrenner
'Damit funktioniert die Umwandlung in Double dann auf jedem System korrekt
Dim dezi As String
Dim tsd As String
Dim wertS As String
Dim V As Variant
Dim K As Integer
MeinSystemFormat = ""
wertS = CStr(wert)
If wertS = "" Then
Exit Function
End If
dezi = Application.DecimalSeparator
tsd = Application.ThousandsSeparator
V = Split(wertS, ",")
For K = 0 To UBound(V)
V(K) = Replace(V(K), ".", tsd)
Next
MeinSystemFormat = Join(V, dezi)
End Function
Function MeinProzentWert(wert As Variant) As Variant
'Rechnet die Prozentangabe von Onvista in eine Zahl um, beachtet systemspezifische Trenner
Dim inhalt As String
MeinProzentWert = ""
inhalt = MeinSystemFormat(wert)
If InStr(inhalt, "%") > 1 Then
inhalt = Replace(inhalt, "%", "")
If IsNumeric(inhalt) Then
MeinProzentWert = CDbl(inhalt) / 100
End If
Else
If IsNumeric(inhalt) Then
MeinProzentWert = CDbl(inhalt)
End If
End If
End Function