Hallo zusammen,

mein Projekt sieht wie folgt aus. Ich habe eine Excel Liste welche diverse Hyperlink (ca. 300) enthält, nun möchte ich diese über ein Makro aufrufen und bestimmte Informationen extrahieren und in die Excel schreiben.

Mein Code funktioniert auch einwandfrei, lediglich mit der Performance (Geschwindigkeit) bin ich noch nicht zufrieden.

Wie muss der Code abgeändert werden damit eine Performacesteigerung spürbar ist. Ich dachte evt. an eine Speicherung in einem Array (Hyperlink --> wobei es auch Zeilen git bei denen kein Hyperlink hinterlegt ist) und die Infos aus dem Explorer (lange Strings) ebenfalls in einem art Array abspeichern...

Über jegliche hilfe bin ich Dankbar und nachfolgend nun der Code:

Option Explicit

Sub StelleninfosAuslesen()

    Dim browser As Object
    Dim nodeJobOffer As Object
    
    Dim jobTasks As String
    Dim jobProfil As String
    
    Dim HyperlinkRow As Long
    Dim Hyperlink As String

    HyperlinkRow = 2

    Do
    
            'Navigation zum Hyperlink sofern es sich um einen handelt, ansonsten wird in der nächsten Zeile fortgefahren
            
            If ActiveSheet.Cells(HyperlinkRow, 2).Hyperlinks.Count = 1 Then
                Hyperlink = ActiveSheet.Cells(HyperlinkRow, 2).Hyperlinks(1).Address
            Else
                HyperlinkRow = HyperlinkRow + 1
                
            End If
            
            'Browser öffnen und laden lassen
            
            Set browser = CreateObject("internetexplorer.application")
                    browser.Visible = False
                    browser.navigate Hyperlink
        
            Do Until browser.readyState = 4: DoEvents: Loop
            
            

            jobTasks = Trim(browser.document.getElementsByClassName("at-section-text-description-content sc-hmzhuo")(0).innertext)
            jobProfil = Trim(browser.document.getElementsByClassName("at-section-text-profile-content sc-hmzhuo")(0).innertext)
        
        
            ActiveSheet.Cells(HyperlinkRow, 8).Value = jobTasks
            ActiveSheet.Cells(HyperlinkRow, 9).Value = jobProfil
        
            browser.Quit
            Set browser = Nothing
            jobTasks = ""
            jobProfil = ""

            HyperlinkRow = HyperlinkRow + 1
    
    Loop Until IsEmpty(ActiveSheet.Cells(HyperlinkRow, 2))

End Sub

Viele Grüße

Tobi