Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Webabfrage > Liste in Spalte A > untereinander

Betrifft: Webabfrage > Liste in Spalte A > untereinander von: Werner
Geschrieben am: 04.08.2014 16:19:06

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

  

Betrifft: AW: Webabfrage > Liste in Spalte A > untereinander von: fcs
Geschrieben am: 05.08.2014 12:33:43

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



  

Betrifft: AW: Webabfrage > Liste in Spalte A > @ FCS von: Werner
Geschrieben am: 06.08.2014 21:43:42

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




  

Betrifft: AW: Webabfrage > Liste in Spalte A > @ FCS von: Werner
Geschrieben am: 06.08.2014 21:45:41

noch offen
sorry, hab das Kästchen wohl nicht angeklickt ;)
jetzt aber


  

Betrifft: AW: Webabfrage > Liste in Spalte A von: fcs
Geschrieben am: 07.08.2014 11:24:37

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



  

Betrifft: AW: Webabfrage > Liste in Spalte A von: Werner
Geschrieben am: 07.08.2014 14:25:08

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


  

Betrifft: AW: Webabfrage > Liste in Spalte A von: fcs
Geschrieben am: 07.08.2014 16:58:50

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


  

Betrifft: DAANKE :) von: Werner
Geschrieben am: 07.08.2014 17:36:02

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


 

Beiträge aus den Excel-Beispielen zum Thema "Webabfrage > Liste in Spalte A > untereinander"