SVERWEIS (für sehr viele Zeilen) über VBA

[friedensbringer]

Hallo zusammen,

ich hoffe ihr könnt mir wieder einmal weiterhelfen.
Ich habe eine Excel Tabelle in der ich einen SVERWEIS über sehr viele Zeilen machen muss.
Im "Zieltabellenblatt" ca. 700.000 Zeilen im "Quelltabellenblatt" ca. "120.000" Zeilen.

Wenn ich versuche das in einem Schwung mittels Formel zu machen dann passiert gar nichts bzw. dauert das ewig und irgendwann "crasht" Excel.
Jetzt habe ich mir gedacht ich mache das mit der Formel nur Zeile für Zeile (oder eventuell ginge auch in größeren Blöcken, zB immer 500 - 1.000 Zeilen)
und schreibe das danach als Werte in die Tabelle damit die Berechnung nie gleichzeitig für so viele Zeilen im Einsatz ist.

Untenstehend einmal das Makro wie ich es aktuell im Einsatz habe.
Funktioniert zwar in dieser Form schon, aber ich denke das lässt sich sicher noch wesentlich schneller und sauberer lösen?
Hab leider wieder durchs aufzeichnen viele "Selects" drinnen - shame on me... :s

Vielen Dank für eure Hilfe und lg

Olli

Code:

Sub SVERWEIS_WERTE()
   
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   
   Dim i As Long
   Dim letztezeile As Long
   
   'Startzeit des Makros
   
   With Sheets("Alle_KD_Artikel")
   .Range("AA1").Value = Format(Date, "DD.MM.YYYY")     ' Datum
   .Range("AB1").Value = Format(Time, "hh:mm:ss")       ' Startzeit
   End With

   'Alte Daten in Spalten R und S löschen
   
   Range("R4:S1048576").Select
   Selection.ClearContents
   
   letztezeile = ActiveSheet.Cells(1048576, 2).End(xlUp).Row 'Ab Excel 2007, definierte Spalte
   
   For i = 4 To letztezeile
   
   'SVERWEIS ohne Prüfungen für Spalte R
   
   '=SVERWEIS($A4;'12M'!$A:$E;4;FALSCH)
   
   Range("R" & i).Select
   Application.CutCopyMode = False
   ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,'12M'!C1:C5,4,FALSE)"
   
   'SVERWEIS ohne Prüfungen für Spalte S
   
   '=SVERWEIS($A4;'12M'!$A:$E;5;FALSCH)
   
   Range("S" & i).Select
   Application.CutCopyMode = False
   ActiveCell.FormulaR1C1 = "=VLOOKUP(RC1,'12M'!C1:C5,5,FALSE)"
   
   Calculate
     
   'Ermitteltes Ergebnis aus Performancegründen als Wert speichern
   Range("R" & i & ":S" & i).Select
   Selection.Copy
   Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
     
   'Zwischenablage leeren
   Application.CutCopyMode = False
     
   'Bei bestimmten Intervallen zwischenspeichern
   
   If i = 100000 Or i = 200000 Or i = 300000 Or i = 400000 Or i = 500000 Or i = 600000 Or i = 700000 Then
       ActiveWorkbook.Save
   End If
   
   'Nächste Zeile
   Next i
   
   '#NV ersetzen
   
   Columns("R:S").Select
   Selection.Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   
   'Nach oben in Zelle A1 springen
   ActiveWindow.ScrollRow = 3
   Range("A1").Select
   
   'Endzeit des Makros
   
   With Sheets("Alle_KD_Artikel")
   .Range("AA2").Value = Format(Date, "DD.MM.YYYY")     ' Datum
   .Range("AB2").Value = Format(Time, "hh:mm:ss")       ' Endzeit
   End With
   
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
   
'    ActiveWorkbook.Save
   
End Sub

[Winny]

Hi

probier's mal so

Code:

Sub SVERWEIS_WERTE()
 'Dim i As Long
 Dim LetzteZeile As Long
 
 Application.ScreenUpdating = False
 'Application.Calculation = xlCalculationManual
 
 With Sheets("Alle_KD_Artikel")
   'Startzeit des Makros
   .Range("AA1").Value = Format(Date, "DD.MM.YYYY")     ' Datum
   .Range("AB1").Value = Format(Time, "hh:mm:ss")       ' Startzeit
   
   'Alte Daten in Spalten R und S löschen
   .Range("R4:S1048576").ClearContents
   
   LetzteZeile = .Cells(1048576, 2).End(xlUp).Row 'Ab Excel 2007, definierte Spalte
   
   'Sortierung ist wichtig wegen Sverweis mit Parameter TRUE
   Sheets("12M").UsedRange.Sort Key1:=Sheets("12M").Range("A1"), Order1:=xlAscending, Header:=xlGuess
   
   .Range("R4:R" & LetzteZeile).FormulaR1C1 = "=IF(VLOOKUP(RC1,'12M'!C1:C1,1,TRUE)=RC1,VLOOKUP(RC1,'12M'!C1:C5,4,TRUE),0)"
   .Range("S4:S" & LetzteZeile).FormulaR1C1 = "=IF(VLOOKUP(RC1,'12M'!C1:C1,1,TRUE)=RC1,VLOOKUP(RC1,'12M'!C1:C5,5,TRUE),0)"
   
   
   'Do
   '  DoEvents
   'Loop Until Application.CalculationState = xlDone
   'With .Range("R4:S" & LetzteZeile)
   '  .Value = .Value
   'End With
   
   '#NV ersetzen
   .Columns("R:S").Replace What:="#N/A", Replacement:="0", LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
   
   'Nach oben in Zelle A1 springen
   ActiveWindow.ScrollRow = 1
   .Range("A1").Select
   
   'Endzeit des Makros
   .Range("AA2").Value = Format(Date, "DD.MM.YYYY")     ' Datum
   .Range("AB2").Value = Format(Time, "hh:mm:ss")       ' Endzeit
 End With
 
 'Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True
 
 '    ActiveWorkbook.Save
 
End Sub

[friedensbringer]

Hallo Winny,

vielen Dank - werde ich entsprechend testen. Leider kommen die Daten im Tabellenblatt 12M aktuell aus einer Pivot, deswegen bekomme ich hier noch einen Fehler.
Ich denke ich muss die Pivot vorher in Werte wandeln damit das funktioniert, oder?

'Sortierung ist wichtig wegen Sverweis mit Parameter TRUE

Sheets("12M").UsedRange.Sort Key1:=Sheets("12M").Range("A1"), Order1:=xlAscending, Header:=xlGuess

Danke und lg

Olli

[Winny]

Hi Olli

Wenn Dein Sverweis() vorher funktioniert hatte dann sollte das jetzt auch funktionieren, Du musst nur sicherstellen dass die Pivot sortiert ist und kannst dann die Sortierung im Modul erst einmal auskommentieren

ist schwierig zu beurteilen, versuche doch mal eine Beispieldatei zu posten, muss ja nicht der gesamte Umfang sein