Hallo zusammen,

um in einer recht großen Anwendung nicht immer den Sverweis bemühen zu müssen, mache ich das beim einlesen meiner Daten per VBA. Da ein einmaliger aufruf der Funktion mittlerweile fast 15 Sekunden braucht, suche ich Ideen, um diese noch etwas zu Pimpen.

Hat jemand dazu ein paar Vorschläge.

Vielen Dank

Piecha

Sub SVerweis_V2(ZielSheet As String, ZielSpalteIndex As String, ZielSpalteVon As String, ZielSpalteBis As String, ZielZeile As Double, ZielZeileAnzahl As Double, QuellSheet As String, QuellSpalteIndex As String, QuellSpalteVon As String, QuellSpalteBis As String, Optional ByVal Format As Boolean = False)
' Quelle immer Sheet(QuellSheet) + Quellspalte
    Dim Counter As Double
    Dim CounterMax As Double
    Dim TempVatiant As Range
    Dim TempDouble As Double
    Dim AnzahlQuellZeilen As Integer
    
    If QuellSheet = "" Then QuellSheet = "Gesammelte_Daten"         'QuellSheet     definieren falls leer
    If QuellSpalteBis = "" Then QuellSpalteBis = QuellSpalteVon     'QuellSpalteBis definieren falls leer
    If ZielSpalteBis = "" Then ZielSpalteBis = ZielSpalteVon        'ZielSpalteBis  definieren falls leer
    
    PrintDebug "Start SVerweis_V2", ZielZeileAnzahl

    With Worksheets(ZielSheet)
        If ZielZeileAnzahl = 0 Then                                  'Anzahl der Aufträge im Prodplan ermitteln
            If WorksheetFunction.CountA(Sheets(ZielSheet).Range("A:A")) < MaxAuftraege Then CounterMax = WorksheetFunction.CountA(Sheets(ZielSheet).Range("A" & ZielZeile & ":A" & MaxAuftraege)) Else CounterMax = MaxAuftraege
        Else
            CounterMax = ZielZeileAnzahl
        End If
        
        'PrintDebug "Start SVerweis_V2 1. If", ZielZeileAnzahl
        
        AnzahlQuellZeilen = WorksheetFunction.CountA(Sheets(QuellSheet).Range(QuellSpalteIndex & ":" & QuellSpalteIndex))
        For Counter = ZielZeile To (CounterMax + ZielZeile)
        
            PrintDebug "Start SVerweis_V2 in der Loop, Counter = ", Counter
        
            Set TempVatiant = Worksheets(QuellSheet).Range(QuellSpalteIndex & "1:" & QuellSpalteIndex & AnzahlQuellZeilen).Find(What:=Worksheets(ZielSheet).Range(ZielSpalteIndex & Counter), LookIn:=xlValues, LookAt:=xlWhole)
            If Not TempVatiant Is Nothing Then TempDouble = TempVatiant.Row Else TempDouble = -1
            If Format Then
                If TempDouble < 0 Then
                    .Range(ZielSpalteVon & Counter) = 0
                Else
                    Worksheets(QuellSheet).Range(QuellSpalteVon & TempDouble & ":" & QuellSpalteBis & TempDouble).Copy .Range(ZielSpalteVon & Counter & ":" & ZielSpalteBis & Counter)
                End If
            Else
                If TempDouble < 0 Then .Range(ZielSpalteVon & Counter) = 0 Else .Range(ZielSpalteVon & Counter & ":" & ZielSpalteBis & Counter).Value = Worksheets(QuellSheet).Range(QuellSpalteVon & TempDouble & ":" & QuellSpalteBis & TempDouble).Value
            End If
        Next Counter
    End With
    Set TempVatiant = Nothing
End Sub