Daten aus dem Internet automatisch in ein Excel-Sheet übertragen

Wie kann man „per Knopfdruck“ bestimmte Daten aus dem Internet zusammensuchen und in ein Tabellenblatt eintragen? Ich zeige in diesem Artikel, wie man einen derartigen „Datensauger“ bauen kann.

Ein Beispiel: Zu einer Liste von Aktien wollen wir jeweils das operative Ergebnis (EBIT) des Unternehmens über die letzten Jahre haben. Daraus soll wiederum die jährliche prozentuale Steigerung des Ergebnisses berechnet werden. Etwa so:

Excel-Tabelle mit Daten

Die Liste der Unternehmen bzw. Aktien (orange) ist vorgegeben. Die Zahlen für EBIT (weiß) sollen durch ein Makro eingetragen werden. Die prozentualen Steigerungen (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 Ariva ziehen. (http://www.ariva.de). Die URLs der benötigten Seiten mit den Kennzahlen der einzelnen Unternehmen haben alle den gleichen Aufbau, und zwar so: http://www.ariva.de/adidas-aktie/bilanz-guv. Statt adidas-aktie steht dann für jede Aktie ein anderer Teil. Wir werden diesen Teil der Einfachheit halber anstatt der ISIN in den linken Bereich der Tabelle schreiben. Wie man automatisch aus der ISIN diesen Ariva-URL-Teil ermitteln kann, werde ich später in einem anderen Artikel erklären. Wir haben dann also eine Tabelle „Zahlen“, die wie folgt aussieht:

Excel-Tabelle Zahlen

In den blauen Zellen stehen Formeln, z.B. für die Steigerung von 2012-13 (Zelle G3):

=WENN(ODER(C3<=0;D3<=0);"";D3/C3-1)

Hier noch für die durchschnittliche jährliche Steigerung (Zelle J3):

=WENN(ODER(G3="";H3="";I3="");"";POTENZ((1+G3)*(1+H3)*(1+I3);1/3)-1)

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 shW As Worksheet, qt As QueryTable
   Dim shZ As Worksheet, zeile As Integer
   Dim url As String, rng As Range, sp2012 As Integer, zeEBIT As Integer

   'Sheet "Web" wird sicherheitshalber geleert:
   Set shW = Sheets("Web")
   shW.Cells.Clear

   'QueryTable für Web-Abfragen wird angelegt:
   Set qt = shW.QueryTables.Add("URL;", shW.Cells(1, 1))
   With qt
      .BackgroundQuery = False
      .RefreshStyle = xlInsertDeleteCells
      .WebSelectionType = xlEntirePage
      .WebFormatting = xlWebFormattingNone
      .WebDisableDateRecognition = True
   End With

   'Die Zeilen des Blattes "Zahlen" werden durchgegangen:
   Set shZ = Sheets("Zahlen")
   zeile = 3
   Do Until shZ.Cells(zeile, 1).Value = ""
      'Fortschrittsanzeige:
      Application.StatusBar = "Zeile " & zeile & _
      " - " & shZ.Cells(zeile, 1).Value
      DoEvents

      'Daten zur aktuellen Zeile werden abgerufen:
      url = "URL;http://www.ariva.de/" + _
      shZ.Cells(zeile, 2).Value + "/bilanz-guv"
      With qt
         .Connection = url
         .Refresh (False)
      End With

      'Heraussuchen der Daten aus dem Blatt "Web":
      Set rng = shW.Cells.Find("2012", shW.Cells(1, 1))
      If Not rng Is Nothing Then
         sp2012 = rng.Column
         Set rng = shW.Cells.Find("Ergebnis (EBIT)", shW.Cells(1, 1))
         If Not rng Is Nothing Then
            zeEBIT = rng.Row
            For k = 0 To 3
               If IsNumeric(shW.Cells(zeEBIT, sp2012 + k).Value) Then
                  shZ.Cells(zeile, 3 + k).Value = _
                  shW.Cells(zeEBIT, sp2012 + k).Value
                  DoEvents
               End If
            Next
         End If
      End If

      zeile = zeile + 1
   Loop

   'Aufräumen und fertig:
   shW.Cells.Clear
   For k = shW.QueryTables.Count To 1 Step -1
      shW.QueryTables(k).Delete
   Next
   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.

Download: mehr Erläuterungen, weitere Ideen, Beispiel-Datei
PDF-E-Book: datensauger-vba.pdf 969 KB
Beispiel-Datei: datensauger-vba.xslm 23 KB

Wichtiger Nachtrag Mai 2017

Wenn durch die Do-Until-Schleife aus dem obigen Code-Beispiel (siehe auch PDF-E-Book bzw. Beispiel-Datei) eine sehr lange Liste abgearbeitet wird, lässt die Performance immer mehr nach, je länger das Ganze läuft. Dafür habe ich eine Lösung gefunden, die darin besteht, die QueryTable vor jedem neuen URL-Abruf zu entsorgen und neu zu initialisieren. Genauer erklärt ist das in diesem Artikel: Bessere Performance bei vielen Web-Abfragen hintereinander

Ein größeres Projekt, in dem das und anderes umgesetzt wurde, ist mein Excel-Tool zur Levermann-Aktienstrategie
Sparen, anlegen, frei sein

Neben anderen interessanten Inhalten stelle ich mein Levermann-Tool auf meinem Blog "Sparen, anlegen, frei sein" unter https://petrawolff.blog zur Verfügung.

2 Kommentare

Schreibe einen Kommentar

Deine E-Mail-Adresse wird nicht veröffentlicht. Erforderliche Felder sind mit * markiert.