AW: Einzelne Daten aus Quelltext in Excel importieren
30.09.2017 23:34:58
Bernd
Ich habe nun drei Makros gemacht, die ich hier gerne mit euch durchkauen würde:
Sub Werte_holen_und_Tabs_erzeugen()
ISIN_in_Name_und_SECU_Umwandeln
Neue_Tabs_aus_Tabelle_erstellen
End Sub
Im obigen Makro führe ich zwei Makros hintereinander aus.
Sub ISIN_in_Name_und_SECU_Umwandeln()
Dim browser As Object
Dim knotenAst As Object
Dim knoten As Object
Dim url As String
Dim Spalte As Integer
Dim startzeile As Integer
Dim endzeile As Integer
Dim numberws As Integer
On Error GoTo Fehler
Tabellenblatt = "Startseite"
Spalte = 3
startzeile = InputBox("Startzeilenummer der ISIN")
endzeile = InputBox("Endzeile der ISIN")
For n = startzeile To endzeile
a = Worksheets(Tabellenblatt).Cells(n, 2).Value 'Aktientitel
b = Worksheets(Tabellenblatt).Cells(n, Spalte).Value 'ISIN
c = Worksheets(Tabellenblatt).Cells(n, 4).Value 'SECU-ID
d = Worksheets(Tabellenblatt).Cells(n, 6).Value 'Börsen ID
e = Worksheets(Tabellenblatt).Cells(n, 7).Value 'Währung
f = Worksheets(Tabellenblatt).Cells(n, 8).Value 'Bereinigung_Splits
g = Worksheets(Tabellenblatt).Cells(n, 9).Value 'Bereinigung_Dividenden
h = Worksheets(Tabellenblatt).Cells(n, 10).Value 'Bereinigung_Bezugsrechte
i = Worksheets(Tabellenblatt).Cells(n, 11).Value 'Anfangsdatum
j = Worksheets(Tabellenblatt).Cells(n, 12).Value 'Enddatum
url = "http://www.ariva.de/" & b & "/historische_kurse"
Set browser = CreateObject("internetexplorer.application")
browser.Visible = False
browser.navigate url
Do Until browser.readyState = 4: DoEvents: Loop
'Auslesen des Aktiennamens aus der Überschrift 'Performance Adidas'
'Es wird zunächst der HTML Abschnitt gesucht, in dem diese Überschrift steht
'Das geht in diesem Fall über den zugewiesenen Namen der CSS Klasse class="arhead"
'Die Element, die diesen Klassennamen enthalten werden durchlaufen. Dabei wird
'für jedes geprüft, ob das Wort 'Performance' vorkommt.
'Die entsprechende Überschrift wird dann ohne das Wort 'Performance' in die
'Exceltabelle ausgegeben. Durch dieses Vorgehen werden auch Aktiennamen vollständig
'ausgegeben, die Leerzeichen enthalten
Set knotenAst = browser.document.getElementsByClassName("arhead")
If Not knotenAst Is Nothing Then
For Each knoten In knotenAst
If InStr(1, knoten.innertext, "Performance") > 0 Then
ActiveSheet.Cells(n, 2).Value = VBA.Trim(Right(VBA.Trim(knoten.innertext), Len( _
_
VBA.Trim(knoten.innertext)) - 11))
End If
Next knoten
Else
'Es wurden keine Seitenelemente gefunden, die den gesuchten Klassennamen enthalten
ActiveSheet.Cells(n, 2).Value = "Kein Aktienname gefunden"
End If
'Entscheidender HTML Abschnitt für SecuNr:
'Zunächst wird ein Array aus allen Tags mit dem Namen 'input' gebildet. Dieses
'Array wird dann durchlaufen, wobei nach dem Attribut 'name' mit dem Wert 'secu'
'gesucht wird. Wurde es gefunden, wird im entsprechenden Code Abschnitt direkt
'auf das Attribut value zugegriffen und der gewünschte Wert wird in die Tabelle
'eingetragen
Set knotenAst = browser.document.getElementsByTagName("input")
If Not knotenAst Is Nothing Then
For Each knoten In knotenAst
If knoten.getAttribute("name") = "secu" Then
ActiveSheet.Cells(n, 4).Value = knoten.getAttribute("value")
End If
Next knoten
Else
'Es wurden keine Seitenelemente gefunden, die den gesuchten Namen enthalten
ActiveSheet.Cells(n, 4).Value = "Keine SecuNr. gefunden"
End If
'Speicher aufräumen
browser.Quit
Set browser = Nothing
Set knotenAst = Nothing
Set knoten = Nothing
Next n
Exit Sub
Fehler:
MsgBox "Ein Fehler ist aufgetreten, bitte Makro bzw. Tabelle überprüfen!"
End Sub
Im obigen Makro habe ich den Code des Vorgängers angepasst auf meine Zwecke. Funktioniert gut.
Kurze Erklärung:
In einer Spalte schreibe ich die ISINs rein, füge die immer in den Link ein und mache dann die Auswertung über den Quelltext.
Sub Neue_Tabs_aus_Tabelle_erstellen()
Dim Spalte As Integer
Dim startzeile As Integer
Dim endzeile As Integer
Dim numberws As Integer
On Error GoTo Fehler
Tabellenblatt = "Startseite"
Spalte = 4
startzeile = InputBox("Startzeilenummer der Aktienkürzel")
endzeile = InputBox("Endzeile der Aktienkürzel")
For n = startzeile To endzeile
a = Worksheets(Tabellenblatt).Cells(n, 2).Value 'Aktientitel
b = Worksheets(Tabellenblatt).Cells(n, Spalte).Value 'ISIN
c = Worksheets(Tabellenblatt).Cells(n, 4).Value 'SECU-ID
d = Worksheets(Tabellenblatt).Cells(n, 6).Value 'Börsen ID
e = Worksheets(Tabellenblatt).Cells(n, 7).Value 'Währung
f = Worksheets(Tabellenblatt).Cells(n, 8).Value 'Bereinigung_Splits
g = Worksheets(Tabellenblatt).Cells(n, 9).Value 'Bereinigung_Dividenden
h = Worksheets(Tabellenblatt).Cells(n, 10).Value 'Bereinigung_Bezugsrechte
i = Worksheets(Tabellenblatt).Cells(n, 11).Value 'Anfangsdatum
j = Worksheets(Tabellenblatt).Cells(n, 12).Value 'Enddatum
ActiveWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;http://www.ariva.de/quote/historic/historic. _
csv?secu=" & c & "&boerse_id=" & d & "¤cy=" & e & "&clean_split=" & f & "&clean_payout=" & g & "&clean_bezug=" & h & "&min_time=" & i & "&max_time=" & j & "" _
, Destination:=Range("$A$1"))
.Name = _
"Ariva_Kurse"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(4, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
ActiveSheet.Name = a
MsgBox "Die Kurse für " & a & " wurden erfolgreich in ein neues Tabellenblatt geladen."
Next n
Exit Sub
Fehler:
MsgBox "Ein Fehler ist aufgetreten, bitte Makro bzw. Tabelle überprüfen!"
End Sub
In diesem Makro habe ich einen Link, den ich mit verschiedenen Variablen aus meiner Tabelle füttere. Das Ergebnis ist ein neuer Tab mit den historischen Aktienwerten. Funktioniert auch gut.
Meine Fragen:
- In beiden Makros wiederholen sich ja Sachen, wie beispielsweise diese Inputbox von Start- und Endzeile. Kann ich das noch irgendwie vereinfachen, so dass ich das nur einmal eingebe?
- Kann allgemein was am Aufbau geändert werden, damit es später vielleicht schneller durchläuft? :)
- Später möchte ich in diesen neu erstellten Tabs noch Spalten mit Formeln einfügen, bspw. Durchschnitte errechnen und auf der Startseite dann anzeigen, ob da einer höher oder niedriger ist (grob gesagt). Was ist hier denn ein Schlagwort mit dem ich nach einer Vorlage googeln kann? :)