Daten aus dem Web automatisch in ein Excel-Sheet übertragen – QueryTable-Variante

Wie kann man „per Knopfdruck“ bestimmte Daten aus dem Internet zusammensuchen und in ein Tabellenblatt eintragen? Im Excel-Blatt werden dann durch Formeln weitere Dinge daraus berechnet. Ich zeige in diesem Artikel eine Möglichkeit, wie man einen derartigen „Datensauger“ bauen kann.

Ein Beispiel: Zu einer Liste von Aktien wollen wir jeweils das KGV übr 5 Jahre berechnen, das ist ein Kurs-Gewinn-Verhältnis. Dabei wird der aktuelle Aktienkurs zum durchschnittlichen Gewinn pro Aktie über 5 Jahre ins Verhältnis gesetzt. Der durchschnittliche Gewinn pro Aktie (oder auch EPS für earnings per share) wird dabei aus den Zahlen der letzten drei abgeschlossenen Jahre und den Schätzungen für das aktuelle und das nächste Geschäftsjahr ermittelt. Etwa so soll das aussehen:

Excel-Tabelle mit Daten

Die Liste der Unternehmen bzw. Aktien (orange) ist vorgegeben. Die Zahlen für den aktuellen Aktienkurs und die EPS-Zahlen vom vorvorletzten bis zum nächsten Geschäftsjahr (weiß) sollen durch ein Makro eingetragen werden. Der EPS-Durchschnitt und dann das KGV über 5 Jahre (blau) werden durch Formeln im Excel-Sheet berechnet.

Als erstes brauchen wir das obige Tabellenblatt. Benennen wir es mit „Zahlen“. Wir werden die Daten von Onvista ziehen. (https://www.onvista.de). Die URLs der benötigten Seiten mit den Kennzahlen der einzelnen Unternehmen haben alle den gleichen Aufbau, und zwar so: https://www.onvista.de/aktien/fundamental/Adidas-Aktie-DE000A1EWWW0. Statt Adidas-Aktie-DE000A1EWWW0 steht dann für jede Aktie der passende Teil. Dieser setzt sich zusammen aus der Bezeichnung, gefolgt von -Aktie- und dazugehöriger ISIN. Der Einfachhait halber gehe ich davon aus, dass wir die Bezeichnung der Aktie bereits in der passenden Schreibweise für die URL haben. Unsere Tabelle „Zahlen“ sieht also wie folgt aus:

Excel-Tabelle Zahlen

In den blauen Zellen stehen Formeln, z.B. für den durchschnittlichen Gewinn pro Aktie (ØEPS) (Zelle K2):

=WENN(ANZAHL(F2:J2)=5;SUMME(F2:J2)/5;"")

Für das KGV über 5 Jahre (KGV5) (Zelle L2):

=WENN(UND(D2<>"";K2<>"";K2>0);D2/K2;"")

Weiterhin brauchen wir noch ein leeres Tabellenblatt, welches wir „Web“ nennen. Das soll als Hilfsblatt zur Durchführung der Web-Abfragen dienen.

Das Herzstück der Lösung wird nun das Makro zum Ziehen der Daten:

Sub Daten()

   'Die Variablen brauchen wir:
    Dim shZ As Worksheet, shW As Worksheet
    Dim zeile As Integer
    Dim url As String
    Dim qt As QueryTable
    Dim rng As Range
    Dim zeileEPS As Integer
    Dim zeileJahr As Integer, spalteLJ As Integer
    Dim zeileF As Integer
    Dim zeileKurs As Integer, zeileDatum As Integer
    Dim k As Integer
    Dim inhalt As String
    Dim V() As String

    'Konstanten für die Zielspalten:
    Const Z_SPALTE_DATUM = 3
    Const Z_SPALTE_KURS = 4
    Const Z_SPALTE_LJ = 5
    Const Z_SPALTE_EPS_LJ = 8

    'die beiden Tabellenblätter:
    Set shZ = Sheets("Zahlen")
    Set shW = Sheets("Web")

   'Rest-QueryTables sicherheitshalber entfernen:
    For Each qt In shW.QueryTables
        qt.Delete
    Next

   'Die Zeilen des Blattes "Zahlen" werden durchgegangen:
    zeile = 2
    Do Until shZ.Cells(zeile, 1).Value = ""

        'Status-Zeilen-Anzeige
        Application.StatusBar = "Zeile " & zeile & _
        " - " & shZ.Cells(zeile, 1).Value
        DoEvents                'damit der Bildschirm aktualisiert wird

        'bereits vorhandene Angaben entfernen
        For k = Z_SPALTE_DATUM To Z_SPALTE_EPS_LJ + 2
            shZ.Cells(zeile, k).Value = ""
        Next

        'Web-Abfrage durchführen
        shW.Cells.Delete
        shW.Cells.NumberFormat = "@"
        url = "https://www.onvista.de/aktien/fundamental/" & _
        Replace(shZ.Cells(zeile, 1).Value, " ", "-") & _
        "-Aktie-" & shZ.Cells(zeile, 2).Value
        Set qt = shW.QueryTables.Add("URL;" & url, shW.Cells(1, 1))
        With qt
            .WebSelectionType = xlEntirePage
            .WebFormatting = xlWebFormattingNone
            .WebDisableDateRecognition = True
            .Refresh (False)
            .Delete   'löscht nur die "Vorrichtung" zur Abfrage, die Daten bleiben
        End With

        'Daten auslesen und an die richtigen Stellen schreiben
        zeileEPS = 0
        Set rng = shW.Cells.Find("Gewinn pro Aktie in EUR", shW.Cells(1, 1))
        If Not rng Is Nothing Then
            zeileEPS = rng.Row
        End If
        If zeileEPS > 0 Then
            zeileJahr = zeileEPS + 4
            spalteLJ = 0
            For k = 2 To 8
                If Not (CStr(shW.Cells(zeileJahr, k).Value) Like "*e") Then
                    spalteLJ = k
                    Exit For
                End If
            Next
            If spalteLJ > 0 Then
                inhalt = CStr(shW.Cells(zeileJahr, spalteLJ).Value)
                If (inhalt Like "####") Or (inhalt Like "##/##") Then
                    shZ.Cells(zeile, Z_SPALTE_LJ).Value = inhalt
                    For k = 2 To -2 Step -1
                        inhalt = CStr(shW.Cells(zeileEPS, spalteLJ + k).Value)
                        'Zahlenformat passend machen und Zahl übernehmen
                        inhalt = Replace(inhalt, ".", "")
                        inhalt = Replace(inhalt, ",", _
                        Application.DecimalSeparator)
                        If IsNumeric(inhalt) Then
                            shZ.Cells(zeile, Z_SPALTE_EPS_LJ - k).Value = _
                            CDbl(inhalt)
                        End If
                    Next
                End If
            End If
        End If
        zeileKurs = 0
        zeileDatum = 0
        Set rng = shW.Columns(1).Find("Fundamental", shW.Cells(1, 1))
        If Not (rng Is Nothing) Then
            zeileF = rng.Row
            For k = 1 To 100
                inhalt = Trim(CStr(shW.Cells(zeileF + k, 1).Value))
                If inhalt Like "##.##.####, ##:##:##" Then
                    zeileDatum = zeileF + k
                    zeileKurs = zeileDatum - 3
                    Exit For
                End If
            Next
            If zeileDatum > 0 Then
                'Datumsteil extrahieren
                V = Split(Left(inhalt, 10), ".")
                shZ.Cells(zeile, Z_SPALTE_DATUM).Value = _
                DateSerial(CInt(V(2)), CInt(V(1)), CInt(V(0)))
                'Kursangabe als Zahl, vorher Format passend machen
                inhalt = CStr(shW.Cells(zeileKurs, 1).Value)
                inhalt = Replace(inhalt, " EUR", "")
                inhalt = Replace(inhalt, ".", "")
                inhalt = Replace(inhalt, ",", Application.DecimalSeparator)
                If IsNumeric(inhalt) Then
                    shZ.Cells(zeile, Z_SPALTE_KURS).Value = CDbl(inhalt)
                End If
            End If
        End If

        zeile = zeile + 1
    Loop                    'nächste Zeile!

    'Blatt "Web" aufräumen
    For Each qt In shW.QueryTables
        qt.Delete
    Next
    shW.Cells.Delete

    Application.StatusBar = "OK"

End Sub

Wenn man möchte, kann man nun noch einen Button oben auf dem Zahlenblatt einfügen und diesem das Makro zuweisen, so dass das wirklich „per Knopfdruck“ funktioniert. Ansonsten kann man das Makro natürlich auch einfach so starten.