Inhalt aus Internet in Tabelle einfügen

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro2() ' Makro2 Makro ActiveWorkbook.Queries.Add Name:="Table 1", Formula:= _ "let" & Chr(13) & "" & Chr(10) & " Quelle = Web.Page(Web.Contents(""https://www. _ offiziellecharts.de/charts/single/for-date-221145580000""))," & Chr(13) & "" & Chr(10) & " Data1 = Quelle{1}[Data]," & Chr(13) & "" & Chr(10) & " #""Geänderter Typ"" = Table.TransformColumnTypes(Data1,{{""Column1"", Int64.Type}, {""Column2"", Int64.Type}, {""Column3"", type text}, {""Column4"", type text}})," & Chr(13) & "" & Chr(10) & " #""Spalte nach Trennzeichen teilen"" = Table.Spli" & _ "tColumn(#""Geänderter Typ"", ""Column4"", Splitter.SplitTextByDelimiter(""#(lf)"", _ QuoteStyle.Csv), {""Column4.1"", ""Column4.2"", ""Column4.3"", ""Column4.4"", ""Column4.5"", ""Column4.6"", ""Column4.7"", ""Column4.8"", ""Column4.9""})," & Chr(13) & "" & Chr(10) & " #""Geänderter Typ1"" = Table.TransformColumnTypes(#""Spalte nach Trennzeichen teilen"",{{""Column4.1"", type text}, {""Column" & _ "4.2"", type text}, {""Column4.3"", type text}, {""Column4.4"", type text}, {""Column4. _ 5"", type text}, {""Column4.6"", type text}, {""Column4.7"", type text}, {""Column4.8"", type text}, {""Column4.9"", type text}})," & Chr(13) & "" & Chr(10) & " #""Entfernte Spalten"" = Table.RemoveColumns(#""Geänderter Typ1"",{""Column4.3"", ""Column4.4"", ""Column4.5"", ""Column4.6"", ""Column4.7"", ""Co" & _ "lumn4.8"", ""Column4.9"", ""Column2"", ""Column3""})" & Chr(13) & "" & Chr(10) & "in" & _ Chr(13) & "" & Chr(10) & " #""Entfernte Spalten""" Sheets.Add After:=ActiveSheet With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _ "OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=""Table 1""; _ Extended Properties=""""" _ , Destination:=Range("$A$1")).QueryTable .CommandType = xlCmdSql .CommandText = Array("SELECT * FROM [Table 1]") .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .PreserveColumnInfo = True .ListObject.DisplayName = "Table_1" .Refresh BackgroundQuery:=False End With Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False Rows("1:1").Select End Sub

Hallo Christian,
da habe ich doch glatt Günthers und Deinen Namen im vorherigen Postig durcheinander gebracht. Sorry dafür.
Wie gesagt, komme ich diese Woche auf keinen Fall mehr dazu. Eigentlich war ich auch nicht traurig darüber, dass Du fast Mitte März für Deinen Bedarf ausgerufen hattest ;-)
Ich habe folgende Fragen:

Du willst ausschließlich Jahrestabellen oder kann es auch vorkommen, dass Du alles in einer Tabelle, in Monatstabellen oder gar vereinzelt in Wochentabellen brauchst?

Am Beispiel Jahrestabellen: In welches Jahr gehören für Dich dann Übergänge, wie 27.12.2004 - 02.01.2005?

Geht es ausschließlich um Single-Charts oder auch um andere? Ich frage, weil es unterschiedliche Starttermine für die verschiedenen Kategorien gibt.

Wird das für Dich eine einmalige Auslesegeschichte oder brauchst Du regelmäßig neue Chart-Daten bzw. unterschiedliche Zeitspannen, bzw. unterschiedliche der angesprochenen Tabellenformen für die gleichen Daten?

Da Threads in diesem Forum nach einer Woche ins Archiv wandern und man dann nicht mehr darauf antworten kann, können wir entweder zu gegebenem Zeitpunkt einen neuen Thread zu diesem Thema eröffnen (z.B. wollte Günther ja gerne das Ergebnis sehen) oder wir verlegen uns auf E-Mail.
Die eigentliche Ausleseroutine für die Daten steht im folgenden Code. Drumrum muss halt das ganze Handling gestrickt werden. Also, automatische Errechnung der Links für größere Zeiträume, gültige Datumsgrenze(n) nach unten für die Charts, ab wann von Montag auf Freitag umgeschaltet wurde, usw.
Einfach den ganzen Code in ein Modul kopieren und das Makro in einer leeren Tabelle starten:


Option Explicit


Sub ChartListeAuslesen()
'Variablen für den Zugriff aufs DOM (Document Object Model)
Dim browser As Object       'Zu verwendende Internet Explorer Instanz
Dim knotenCharts As Object  'HTML Teilstruktur der Chart-Tabelle des DOM aufnehmen
Dim knotenPlaetze As Object 'HTML Teilstruktur aus knotenCharts als Zeilensammlung aufnehmen
Dim knotenPlatz As Object   'HTML Einzelplätze (Zeilen) aus knotenPlaetze aufnehmen
Dim knoten As Object        'HTML Unterstruktur aus knotenPlatz aufnehmen (die Daten)
'Sonstige Variablen
Dim aktuelleZeile As Long   'Aktuelle Zeile für das Eintragen der ausgelesenen Daten
Dim url As String           'Aufnahme der auszulesenden Internetadresse
'Kopfzeile schreiben und Spalten Formatieren
KopzeileUndSpaltenFormate
'Startzeile initialisieren
aktuelleZeile = 2
'Als auszulesende Chart-Seite nehme ich mal die aus Deinem Ausgangsposting
url = "https://www.offiziellecharts.de/charts/single/for-date-1135930830000"
'Aufrufen der Chart-Seite im Internet Explorer
Set browser = CreateObject("internetexplorer.application")  'IE als Browser setzen
browser.Visible = False                                     'IE unsichtbar
browser.navigate url                                        'URL aufrufen
Do Until browser.readyState = 4: DoEvents: Loop             'Warten bis Seite ganz geladen
'Beginn des Auslesens der benötigten Daten der im IE geladenen Chart-Seite
'Ausschneiden der gesamten Chart-Tabelle aus dem HTML-Code
Set knotenCharts = browser.document.getElementsByClassName("table chart-table")(0)
'Prüfen, ob die Tabelle vorhanden ist
If Not knotenCharts Is Nothing Then
'Wenn ja, Tabelle in Einzelzeilen-Sammlung aufteilen
Set knotenPlaetze = knotenCharts.getElementsByTagName("tr")
'Alle Platzierungen (Zeilen) durchlaufen und Daten auslesen
For Each knotenPlatz In knotenPlaetze
'aktuelle Platzierung
'Zielspalte 1 in Makro-Start-Tabelle mit Kopfzelle "Platz"
Set knoten = knotenPlatz.getElementsByClassName("this-week")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 1).Value = VBA.Trim(knoten.innertext)
Else
Cells(aktuelleZeile, 1).Value = "NA"
End If
'Platzierung der Vorwoche
'Zielspalte 2 in Makro-Start-Tabelle mit Kopfzelle "Vorwoche"
Set knoten = knotenPlatz.getElementsByClassName("last-week")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 2).Value = VBA.Trim(knoten.innertext)
End If
'Falls Neu
Set knoten = knotenPlatz.getElementsByClassName("trend-new")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 2).Value = Trim(Cells(aktuelleZeile, 2).Value & " Neu")
End If
'Falls REE
Set knoten = knotenPlatz.getElementsByClassName("trend-ree")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 2).Value = Trim(Cells(aktuelleZeile, 2).Value & " Ree")
End If
'Interpret
'Zielspalte 3 in Makro-Start-Tabelle mit Kopfzelle "Interpret"
Set knoten = knotenPlatz.getElementsByClassName("info-artist")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 3).Value = VBA.Trim(knoten.innertext)
Else
Cells(aktuelleZeile, 3).Value = "NA"
End If
'Titel
'Zielspalte 4 in Makro-Start-Tabelle mit Kopfzelle "Titel"
Set knoten = knotenPlatz.getElementsByClassName("info-title")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 4).Value = VBA.Trim(knoten.innertext)
Else
Cells(aktuelleZeile, 4).Value = "NA"
End If
'Label
'Zielspalte 5 in Makro-Start-Tabelle mit Kopfzelle "Label"
Set knoten = knotenPlatz.getElementsByClassName("info-label")(0)
If Not knoten Is Nothing Then
Cells(aktuelleZeile, 5).Value = VBA.Trim(knoten.innertext)
Else
Cells(aktuelleZeile, 5).Value = "NA"
End If
'Nächste zu beschreibende Zeile festlegen
aktuelleZeile = aktuelleZeile + 1
Next knotenPlatz
Else
'Wenn nein, entsprechende Nachricht ausgeben
MsgBox "Keine Chart-Tabelle vorhanden"
End If
'Aufräumen
browser.Quit
Set browser = Nothing
Set knotenCharts = Nothing
Set knotenPlaetze = Nothing
Set knotenPlatz = Nothing
Set knoten = Nothing
End Sub


Private Sub KopzeileUndSpaltenFormate()
Cells(1, 1).Value = "Platz"
Cells(1, 2).Value = "Vorwoche"
Cells(1, 3).Value = "Interpret"
Cells(1, 4).Value = "Titel"
Cells(1, 5).Value = "Label"
Columns("A:B").ColumnWidth = 12
Columns("C:C").ColumnWidth = 50
Columns("D:D").ColumnWidth = 50
Columns("E:E").ColumnWidth = 15
Cells.VerticalAlignment = xlCenter
Rows("1:1").VerticalAlignment = xlBottom
Range("A:B").HorizontalAlignment = xlCenter
Range("A1:B1").HorizontalAlignment = xlLeft
Range("C1:E1").HorizontalAlignment = xlCenter
Range("A1:E1").Font.Bold = True
Range("A1:E1").Font.ThemeColor = xlThemeColorLight1
Range("A1:E1").Font.ThemeColor = xlThemeColorDark1
Range("A1:E1").Interior.ThemeColor = xlThemeColorLight1
Columns("A:B").NumberFormat = "#,##0"
Columns("C:E").NumberFormat = "@"
ActiveWindow.SplitColumn = 0
ActiveWindow.SplitRow = 1
ActiveWindow.FreezePanes = True
Cells(1, 1).Select
Selection.AutoFilter
End Sub

Ich verlinke mal einen meiner alten Beiträge, in dem ich mal einige Grundlagen zum DOM beschrieben habe:
Auslesen von NBA Ergebnissen:
https://www.herber.de/cgi-bin/callthread.pl?index=1492241#1493245
Excel Datei mit dem Makro zum Auslesen der NBA Ergebnisse:
(über den Ursprungs-Thread nicht mehr downloadbar)
https://www.herber.de/bbs/user/113778.xlsm
Viele Grüße,
Zwenn

Moin Zwenn, Christian
gerade wegen Christians Beitrag möchte ich doch etwas näher darauf eingehen, was ich in meinem vorherigen Beitrag geschrieben habe. Aber eines nach dem anderen
@Zwenn: Erst einmal danke für die Blumen; die Website/der Blog kostet aber auch enorm viel Zeit! - Ich hatte zu Anfang ja auch schon erwähnt, dass ich wahrscheinlich solch ein Problem auch mit VBA lösen würde bzw. andere Wege sinnvoll wären. Was Power Query angeht: Ja im Moment ist das für mich ein Bereich, wo ich "normalen" Usern einige Möglichkeiten gebe, die sie sonst nur mit einem sehr hohen Aufwand, ausgesprochen guten Kenntnissen in Excel-Funktionen oder VBA hätten. Und ich denke dass wir uns einig sind, dass dieses in der überwiegenden Anzahl der Fälle nicht gegeben ist. Dazu kommt speziell hier noch meine Fehlinterpretation, dass ich davon ausgegangen bin, dass künftig in regelmäßigen Abständen eine derartige Abfrage stattfinden soll.
Das "rudimentäre" an der Mustertabelle bezog sich darauf, dass ich weder Zeit noch Lust hatte, alle Interpreten durch ein Pipe Symbol abzutrennen. Ich habe mich beispielhaft auf die ersten mir bekannten Interpreten beschränkt, wo ich sicher war, den Namen vom Titel korrekt abzutrennen. 8-) Wo ich das nicht getan habe (beispielsweise der Zeile 4 in der erstellten Tabelle) kommt es natürlich zum Crash. Ist der Name der Interpreten nun 'Melanie C' oder nur 'Melanie'? Wenn der Interpret fehlt, gehört natürlich vor den Song-Titel auch ein |.
Ich würde mich aber sehr freuen, wenn ich durch dich in Sachen Datentransfer Internet->CSV oder Excel einen guten Weg kennenlernen würde, wo ich auf (nur) tabellarisch aussehende Daten zugreifen kann, die aber beispielsweise durch PHP nur in dieser Form dargestellt werden, ohne dass sie eine Tabelle im Sinne des HTML sind. Öfter einmal habe ich zwar dieses Manko bemerkt, bin aber noch nicht in die Recherche eingestiegen. Und ich freue mich jetzt schon auf deinen Beitrag wo du dich mit dem Bulk-Import von den Daten aus der hier eine Rolle spielenden Internet-Seite auseinandersetzt.
@Christian: Grundsätzlich meine ich, dass die über den aufgezeigten Weg zum Ziel kommen kannst. Da die aber noch eine große Anzahl von Daten fehlen (das hatte ich nicht gewusst/bemerkt) wäre vielleicht ein von Zwenn aufzuzeigender Weg hilfreich. Ich selbst beschäftige mich ja mehr oder weniger "nebenbei" mit der Hilfe in Foren, denn (obwohl Rentner) muss ich mir noch ein paar Euro dazu verdienen. Und da zählt nun einmal das jeweils aktuelle Projekt. - Aber du kannst ja gerne mal folgendes tun: ersetze doch einmal in Spalte_I meiner letzten Tabelle 'Wham! ' (also mit dem angehängten Leerzeichen) durch 'Wham|' und auch entsprechend 'Shakira ' durch 'Shakira|'. Dann sollten zumindest in diesen Zeilen jeweils alle Spalten korrekt gefüllt sein und somit keine Fehlinterpretationen zustande kommen. Im Endeffekt ist das bei allen noch nicht abgetrennten Interpreten geschehen. Übrigens: genau das war auch der Grund, warum ich die Hilfs-Spalten angelegt hatte. Da kann ich sehr schön per Filter kontrollieren, wo in den ersten 20 Zeichen noch kein | vorhanden ist und ich entsprechend den Interpreten noch vom Titel trennen muss.
So, das soll's erst einmal gewesen sein. Für mich ging es in 1. Linie um der Herausforderung, ob so etwas mit Power Query machbar ist oder nicht. Ob ich so etwas für einen Kunden gemacht hätte, kann ich einfach nicht sagen; ich würde wahrscheinlich zu viel nachfragen müssen in Sachen Musik und wann ich wo wie an die Daten komme, was ja schnell als mangelnde Kompetenz ausgelegt wird. Übrigens ist das der wichtigste Grund, warum ich weder in Foren noch für Kunden etwas in Sachen 'Sport' Mache.
Beste Grüße
Günther

Beliebteste Forumthreads (12 Monate)

Inhalt aus Internet in Tabelle einfügen

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Inhalt aus Internet in Tabelle einfügen

19 Beiträge zum Forumthread Beiträge zu diesem Forumthread

309 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

19
Beiträge zum Forumthread

Beiträge zu diesem Forumthread