Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Webabfrage > Liste in Spalte A > untereinander

Webabfrage > Liste in Spalte A > untereinander
04.08.2014 16:19:06
Werner
Hallo Excel-Freunde
ich habe im Thread
https://www.herber.de/forum/archiv/1292to1296/t1293252.htm
einen Code von fcs gefunden, der der Reihe nach
eine Webabfrage für alle Links in Spalte A abruft / kopiert
und diese Ergebnisse dann in jeweils ein Tabellenblatt kopiert.
Funktioniert auch reibungslos.
Ich möchte jedoch, dass die Ergebnisse der Webabfrage
# in ein neues Blatt kopiert (macht er ja)
# dann nur die Ergebnisse der Zellen A40 bis A 50
kopiert und in eine neue Datei "transportiert"
also von A1 bis K1
# dann der 2 Link abgefragt wird
und wieder rum die Zellen A40 bis A50
in die neue Datei dann halt in Zellen A2 bis K2
kopiert usw
Die einzelne Webabfrage pro Link kann dann wieder gelöscht werden.
Geht so etwas ?
Freu mich auf einen Tip
Gruss
Werner
Hier der Code aus dem alten Thread
Sub Makro1()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strCon As String
Dim wbZiel As Workbook, wksZiel As Worksheet, iCount As Integer
Dim strName As String
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For lngZeile = 1 To lngZeile 'Startzeile der Liste ggf. anpassen!
iCount = iCount + 1
If wbZiel Is Nothing Then
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
Set wksZiel = wbZiel.Worksheets(1)
Else
Set wksZiel = wbZiel.Worksheets.Add(after:=wksZiel)
End If
strLink = wksListeLinks.Cells(lngZeile, 1)
strCon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strCon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If iCount = 50 Then '50 = max. Anzahl Tabellenblätter (Abfragen) pro Arbeitsmappe
'für den Max-Wert sind Werte von 1 bis ca. 250 (Excel 2003) zulässig.
iCount = 0
Set wbZiel = Nothing
End If
Next lngZeile
End Sub

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Webabfrage > Liste in Spalte A > untereinander
05.08.2014 12:33:43
fcs
Hallo Werner,
grundsätzlich kann man so etwas machen. Da die Aktualisierung vieler Links ggf. Zeit benötigt, und die Aktualisierung abgeschlossen sein muss bevor die Daten kopiert werden hab ich das Kopieren hinter das Erstellen aller Tabellenblätter gelegt. Zusätzlich wird das Kopieren per OnTime zeitverzögert ausgeführt.
Du kannst die Ontime-Zeile aber auch rausnehmen und das Kopiermakro von Hand starten, wenn du sicher bist, dass alle Link-Daten in den Tabellenblättern aktuell sind.
Gruß
Franz
Option Explicit
Private arrDateien(), intDatei As Integer     'neu
Sub Get_Link_Data()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strCon As String
Dim wbZiel As Workbook, wksZiel As Worksheet, iCount As Integer
Dim strName As String
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
intDatei = 0                                'neu
Erase arrDateien                            'neu
For lngZeile = 1 To lngZeile 'Startzeile der Liste ggf. anpassen!
iCount = iCount + 1
If wbZiel Is Nothing Then
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
intDatei = intDatei + 1                     'neu
ReDim Preserve arrDateien(1 To intDatei)    'neu
arrDateien(intDatei) = wbZiel.Name          'neu
Set wksZiel = wbZiel.Worksheets(1)
Else
Set wksZiel = wbZiel.Worksheets.Add(after:=wksZiel)
End If
strLink = wksListeLinks.Cells(lngZeile, 1)
strCon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strCon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False           'geändert
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
If iCount = 50 Then '50 = max. Anzahl Tabellenblätter (Abfragen) pro Arbeitsmappe
'für den Max-Wert sind Werte von 1 bis ca. 250 (Excel 2003) zulässig.
iCount = 0
Set wbZiel = Nothing
End If
Next lngZeile
Application.OnTime earliesttime:=Now + TimeSerial(Hour:=0, Minute:=0, Second:=10), _
Procedure:="prcCopyZell_Bereiche" 'Wartezeit für Aktualisierung der links = 10 s - ggf.  _
anpassen - neu
End Sub
Sub prcCopyZell_Bereiche()
'kopiert Zellbereich aus den Tabellenblättern mit Internet-Link-Daten in eine Tabelle
Dim wbQ As Workbook, wksQ As Worksheet, wksZiel As Worksheet, lngZeile As Long
If intDatei > 0 Then
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wksZiel = ActiveSheet
lngZeile = 0
'Dateien mit den Tabelen mit Internet-Link-Daten abarbeiten
For intDatei = 1 To UBound(arrDateien)
Set wbQ = Application.Workbooks(arrDateien(intDatei))
'alle Tabellenblätter in datei abarbeiten
For Each wksQ In wbQ.Worksheets
lngZeile = lngZeile + 1
wksQ.Range("A40:A50").Copy
wksZiel.Cells(lngZeile, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
Next
'Datei schließen ohne Speichern
wbQ.Close savechanges:=False
Next
intDatei = 0
Erase arrDateien
Else
MsgBox "Es sind keine auszuwertenden Dateien vorhanden"
End If
End Sub

Anzeige
AW: Webabfrage > Liste in Spalte A > @ FCS
06.08.2014 21:43:42
Werner
Hi Franz,
grandios ! Funktioniert perfekt.
Das Makro prcCopyZell_Bereiche() muss ich nur generell manuell starten, da ich eine Fehlermeldung erhalte (...ist in aktueller Datei nicht vorhanden oder Makro deaktiviert)
Ist aber kein Prob, wenn ich in die "Quell-Datei mit den Link-Angaben" zurückgehe und von dort aus das Makro starte.
Nur eine Frage:
Wenn ich die Webabfrage starte - und ganz viele Seiten - z.B. auf
de.wiktionary.org/wiki/Verzeichnis:International/Männliche_Vornamen#A und ff aber auch für weibliche Vornamen usw
werden von Excel neue XLS mit 50 Tabs im "Hintergrund" eröffnet
die massiv meinen Speicher (?) belasten.
Nach knapp 80 Dateien schreibt mir Excel "Excel reagiert nicht mehr" (also 80Dateien * 50Tabs)
Kann man das so "erweitern", dass die per Web-Abfrage kopierten Inhalten sofort in eine "Ergebnis-Datei" geschrieben werden ?
Wäre genial - und freu mich auf einen weitern Tip von Dir, Franz :)
Besten Abend-Gruss
Werner

Anzeige
AW: Webabfrage > Liste in Spalte A > @ FCS
06.08.2014 21:45:41
Werner
noch offen
sorry, hab das Kästchen wohl nicht angeklickt ;)
jetzt aber

AW: Webabfrage > Liste in Spalte A
07.08.2014 11:24:37
fcs
Hallo Werner,
musst du auch gleich übertreiben und die Daten von 8000 Links importieren.
Bei 80 geöffneten Dateien und jeder Menge Abfragen kommt Excel wahrscheinlich bei der Verwaltung von Arbeitsspeicher und ausgelagerten Daten ins Schleudern.
prcCopyZell_Bereiche wird wahrscheinlich nicht gestartet, weil du die Makros in einem Tabellenmodul der Datei angelegt hast, statt in einem allgemeinen Modul.
Ich hab das Ganze jetzt so umgestrickt, dass nur noch eine Zieldatei mit zwei Tabellenblättern angelegt wird. Im ersten Blatt werden die Daten der einzelnen Links gesammelt, im zweiten Blatt werden die Abfragen für die einzelnen Links anglegt und nach jedem Link wieder gelöscht. Das 2. Blatt wird am Schluß wieder gelöscht.
Ich hab es mit 4 Links getestet.
Die Linkdaten werden scheinbar immer komplett geladen, bevor das Makro kopiert. Das musst du ggf. nochmals prüfen.
Gruß
Franz
Sub Get_Link_Data_Neu()
Dim wksListeLinks As Worksheet, lngZeile As Long
Dim strLink As String, strCon As String
Dim wbZiel As Workbook, wksZiel As Worksheet
Dim wksZiel2 As Worksheet, Zeile2 As Long
Dim strName As String
Dim varTime
Set wksListeLinks = ActiveSheet
With wksListeLinks
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Zeile2 = 0
Application.Workbooks.Add Template:=xlWBATWorksheet
Set wbZiel = ActiveWorkbook
Set wksZiel2 = wbZiel.Worksheets(1)
wbZiel.Worksheets.Add after:=wksZiel2
Set wksZiel = wbZiel.Worksheets(2)
wksZiel.Activate
Application.ScreenUpdating = False
For lngZeile = 1 To lngZeile 'Startzeile der Liste ggf. anpassen!
Application.StatusBar = "Link Nr. " & Format(lngZeile, "0000") & " wird eingelesen"
strLink = wksListeLinks.Cells(lngZeile, 1)
strCon = "URL;" & strLink
strName = strLink
With wksZiel.QueryTables.Add(Connection:=strCon, _
Destination:=wksZiel.Range("A1"))
.Name = strName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False           'geändert
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Zeile2 = Zeile2 + 1
wksZiel.Range("A40:A50").Copy
wksZiel2.Cells(lngZeile, 1).PasteSpecial Paste:=xlPasteAll, Transpose:=True
wksZiel.UsedRange.Clear
wbZiel.Connections(1).Delete
Next lngZeile
Application.StatusBar = False
Application.DisplayAlerts = False
wksZiel.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Anzeige
AW: Webabfrage > Liste in Spalte A
07.08.2014 14:25:08
Werner
Hi Franz,
wieder supergut :)
1. ja, ich hatte das nicht in ein Modul gepackt - deshalb startete der Code nicht automatisch ;)
Das mit dem
Die Linkdaten werden scheinbar immer komplett geladen, bevor das Makro kopiert. Das musst du ggf. nochmals prüfen.
hab ich nicht verstanden ?
Nur eines: jetzt geht mit Excel in die Knie "keine Rückmeldung" wenn er knapp über 100 Links kopiert hat. Mal waren es 138, mal 104, mal 128 ...
Wenn ich wenig Links "importiere", macht das Makro genau das was es soll ;))
Nur warum ist die Excel-Performance jetzt noch schlechter als bei deinem ersten Beispiel ?
Hab sogar im Task-Manager die Excel Priorität auf HOCH gesetzt ... trotzdem
Hast Du noch eine Idee ? Oder muss ich mir einen neuen Rechner kaufen ;)
Besten Gruss
Werner

Anzeige
AW: Webabfrage > Liste in Spalte A
07.08.2014 16:58:50
fcs
Hallo Werner,
Die Linkdaten werden scheinbar immer komplett geladen, bevor das Makro kopiert. Das musst du ggf. nochmals prüfen.
hab ich nicht verstanden ?

In der Vergangenheit ist es mir schon passiert, dass ein Makro die nächste Aktion ausführte bevor ein Datenimport abgeschlossen war. Deshalb bei den letzten bearbeitten Links prüfen, ob Daten in Liste vollständig sind.
Nur eines: jetzt geht mit Excel in die Knie "keine Rückmeldung" wenn er knapp über 100 Links kopiert hat. Mal waren es 138, mal 104, mal 128 ...
Das ist zunächst mal kein Problem. Excel arbeitet meistens im Hintergrund weiter und irgendwann tauch es wieder aus der Versenkung auf. Leider kann man in dieser Phase das Makro nicht per ESC-Taste anhalten.
Wenn ich wenig Links "importiere", macht das Makro genau das was es soll ;))

Das ist normal.
Nur warum ist die Excel-Performance jetzt noch schlechter als bei deinem ersten Beispiel ?
Hab sogar im Task-Manager die Excel Priorität auf HOCH gesetzt ... trotzdem

Ich hab jetzt keinen test mit mehreren 100 Links gemacht. Möglicherweise schafft Excel es schneller neue Tabellenblätter und dateien zu generieren als Zellbereich zu löschen und mit neuen Daten zu überschreiben.
Hast Du noch eine Idee ?
1. Ändere in der älteren Version die max. Blattzahl von 50 auf 200 oder unter Excel 2007 und neuer auch auf 500.
2. Arbeite die mehrere 1000 Links nicht in einem Block ab sondern in mehreren Blöcken. Die Ergebnisse kannst du dann ja immer noch zusammenkopieren.
Oder muss ich mir einen neuen Rechner kaufen ;)
Nur wenn du einen sehr langsamen Rechner mit sehr wenig Arbeitsspeicher hast.
Ansonsten: Die Verarbeitung großer Datenmengen braucht nun einmal ihre Zeit - und 4000 links sind halt schon einemal eine Hausnummer.
Gruß
Franz

Anzeige
DAANKE :)
07.08.2014 17:36:02
Werner
Hallo Franz,
ja, DANKE für Deine Antworten.
ja, ich werde es mal mit xls2010 durchführen und Deine erste Version in "Etappen" bearbeiten.
Mein Rechner ist erst 1,5 Jahre alt - also keine "alte Möhre" ;)
Vielleicht war/bin ich auch zu ungeduldig - und muss die Meldung "keine Rückmeldung" mit Geduld abwarten.
Franz - du bekommst von mir einen grossen Daumen nach oben !
Tolle Lösung - und auch extrem schnelle Antwort.
Du hast mir geholfen :))
Besten Gruss - bis das nächste Mal ;)
Werner

306 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige