VBA: Schleife über Spalten

Forumthread: VBA: Schleife über Spalten

07.08.2018 18:32:31

Bernd

Hallo zusammen,
brauche mal Hilfe, da meine VBA-Kenntnisse noch nicht reichen.
Musterdatei: https://www.herber.de/bbs/user/123191.xlsm
In meiner Datei rufe ich mit "WebBrowser.Navigate" eine Webseite auf, kopiere die komplette Seite und füge die Daten in ein neuanzulegendes Tabellenblatt ein, der Name der neuen Tabelle soll aus Spalte A in Blatt "Links" analog zur Zeile des Hyperlinks entnommen werden. D.h. rufe ich Hyperlink aus B2 auf, so muss der Blattname aus A2 sein. Bis dahin ok-
Mein Problem ist, dass ich es einfach nicht schaffe, die Hyperlinks in Spalte B und die Blattnamen in Spalte A in eine Schleife zu packen und der Reihe nach abzuarbeiten. In Originaldatei sind es ca. 100 Zeilen, im Muster 3.
Kann mit dabei jemand helfen?
Dankeschön im Voraus!!!
Übrigens der Code stammt von Nepumuk (im Web gefunden), etwas abgewandelt von mir.
Userbild

Office Version 2016 Pro 32bit - Windows10 Pro 64 bit
"Wenn du jemanden ohne Lächeln triffst, schenke ihm dein's!"

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: VBA: Schleife über Spalten

07.08.2018 19:48:51

Nepumuk

Hallo Bernd,
teste mal:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Private Sub UserForm_Activate()
    Call DownLoadData
End Sub

Public Sub DownLoadData()
    Dim lngRow As Long
    Dim objWorksheet As Worksheet
    With Worksheets("Links")
        For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Call WebBrowser1.Navigate(URL:=.Cells(lngRow, 2).Value)
            Do While WebBrowser1.Busy
                Call Sleep(100)
                DoEvents
            Loop
            Call WebBrowser1.ExecWB(cmdID:=OLECMDID_SELECTALL, _
                cmdexecopt:=OLECMDEXECOPT_DONTPROMPTUSER, pvaIn:=0, pvaOut:=0)
            Call WebBrowser1.ExecWB(OLECMDID_COPY, _
                cmdexecopt:=OLECMDEXECOPT_DONTPROMPTUSER, pvaIn:=0, pvaOut:=0)
            Call WebBrowser1.Navigate(URL:="about:blank")

            Set objWorksheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            With objWorksheet
                Call .Paste(Destination:=.Cells(1, 1))
                Call .Range("1:2,5:6").Delete(Shift:=xlShiftUp)
                With .Cells
                    .WrapText = False
                    .MergeCells = False
                End With
                .Name = Worksheets("Links").Cells(lngRow, 1).Value
            End With
        Next
    End With
End Sub

Gruß
Nepumuk

AW: VBA: Schleife über Spalten

07.08.2018 20:14:08

Bernd

Hallo Nepumuk,
Danke für deine Hilfe. Habe den Code getestet und bekomme Fehlermeldung "Variable nicht definiert" und zwar in deiser Zeile hier "Call WebBrowser1.ExecWB(cmdID:=OLECMDID_SELECTALL, _"
Sonnnige Grüße aus Bremen
Bernd

AW: Funktioniert Ein Verweis hat gefehlt ...

07.08.2018 20:17:32

Bernd

... und zwar Microsoft Internet Controls
Danke dir und schönen Abend noch!!!
Gruß
Bernd

AW: VBA: Schleife über Spalten

07.08.2018 20:22:54

Nepumuk

Hallo Bernd,
dann fehlt der Verweis. So sollte es gehen:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Private Sub UserForm_Activate()
    Call DownLoadData
    Call Unload(Object:=Me)
End Sub

Public Sub DownLoadData()
    Dim lngRow As Long
    Dim objWorksheet As Worksheet
    With Worksheets("Links")
        For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Call WebBrowser1.Navigate(URL:=.Cells(lngRow, 2).Value)
            Do While WebBrowser1.Busy
                Call Sleep(100)
                DoEvents
            Loop
            Call WebBrowser1.ExecWB(cmdID:=17, cmdexecopt:=2, pvaIn:=0, pvaOut:=0)
            Call WebBrowser1.ExecWB(cmdID:=12, cmdexecopt:=2, pvaIn:=0, pvaOut:=0)
            Call WebBrowser1.Navigate(URL:="about:blank")

            Set objWorksheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            With objWorksheet
                Call .Paste(Destination:=.Cells(1, 1))
                Call .Range("1:2,5:6").Delete(Shift:=xlShiftToLeft)
                With .Cells
                    .WrapText = False
                    .MergeCells = False
                End With
                .Name = Worksheets("Links").Cells(lngRow, 1).Value
            End With
        Next
    End With
End Sub

Gruß
Nepumuk

AW: VBA: Schleife über Spalten

07.08.2018 20:31:22

Bernd

Hallo Nepumuk,
Alles zurück, funktioniert doch nicht. Gerade fiel mir auf, dass immmer die selbe Webseite als Tabelle angelegt wird, d.h. es wurde immer der selbe Hyperlink angewendet, anstatt die Spalte der Hyperlinks der Reihe nach abzuarbeiten.
Gruß
Bernd

AW: VBA: Schleife über Spalten

07.08.2018 20:16:30

Nepumuk

Hallo Bernd,
ich nochmal, das Shift-Statement der Delete-Methode des Range Objektes stimmt nicht.
So ist's richtig:

Call .Range("1:2,5:6").Delete(Shift:=xlShiftToLeft)

Gruß
Nepumuk

AW: VBA: Schleife über Spalten

07.08.2018 20:21:24

Bernd

Hallo Nepumuk,
Alles zurück funktioniert doch nicht. Gerade fiel mir auf, dass immmer die selbe Webseite als Tabelle angelegt wird, d.h. es wurde nur der selbe Hyperlink angewendet.
Gruß
Bernd

AW: VBA: Schleife über Spalten

07.08.2018 22:00:50

Nepumuk

Hallo Bernd,
dann teste mal:

Option Explicit

Private Declare PtrSafe Sub Sleep Lib "kernel32.dll" ( _
    ByVal dwMilliseconds As Long)

Private Sub UserForm_Activate()
    Call DownLoadData
    Call Unload(Object:=Me)
End Sub

Public Sub DownLoadData()
    Dim lngRow As Long
    Dim objWorksheet As Worksheet
    With Worksheets("Links")
        For lngRow = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
            Call WebBrowser1.Navigate(URL:=.Cells(lngRow, 2).Value)
            Do While WebBrowser1.Busy
                Call Sleep(100)
                DoEvents
            Loop
            Do Until WebBrowser1.ReadyState = READYSTATE_COMPLETE
                Call Sleep(100)
                DoEvents
            Loop
            Call WebBrowser1.ExecWB(cmdID:=OLECMDID_SELECTALL, _
                cmdexecopt:=OLECMDEXECOPT_DONTPROMPTUSER)
            Call WebBrowser1.ExecWB(OLECMDID_COPY, _
                cmdexecopt:=OLECMDEXECOPT_DONTPROMPTUSER)
            Set objWorksheet = Worksheets.Add(After:=Worksheets(Worksheets.Count))
            With objWorksheet
                Call .Paste(Destination:=.Cells(1, 1))
                Call .Range("1:2,5:6").Delete(Shift:=xlShiftToLeft)
                With .Cells
                    .WrapText = False
                    .MergeCells = False
                End With
                .Name = Worksheets("Links").Cells(lngRow, 1).Value
            End With
        Next
    End With
End Sub

Gruß
Nepumuk

AW: VBA: Schleife über Spalten

07.08.2018 23:18:30

Bernd

Hallo Nepumuk,
zu so später Stunde habe ich gar nicht mehr mit dir gerechnet. Aber nun läuft der Code perfekt durch.
Bin dir wiedermal sehr dankbar!!!
Liebe Grüße aus Bremen
Bernd

Beliebteste Forumthreads (12 Monate)

Forumthread: VBA: Schleife über Spalten

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

VBA: Schleife über Spalten

Forumthread: VBA: Schleife über Spalten

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread