Hallo zusammen,
ich habe mir aus ftexibilitätsgründen ein SVerweis selber programmiert. Dieser funktionierte auch bis vor kurzem schnell und gut. Doch jetzt, aus unersichtlichen Gründen braucht die Zeile:
If Not TempVatiant Is Nothing Then TempDouble = TempVatiant.Row Else TempDouble
über 2 Sekunden (vorher ca. 1% der Zeit)
Der bereich, welcher durchsucht wird hat ca 3000 Zeilen.
Berechnungen und Bildschiraktualisierung sind ausgeschaltet
Ev. hat jemand von euch eine Idee.
Danke
Piecha
Hier der gesammte Code:
Sub SVerweis_Prodplan_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
|