Suche beschleunigen

Hallo Excel-Profis,
ich loope durch ein Blatt1 und suche zu jeder Zeile etwas in einem weiteren Blatt. Finde ich den Eintrag schreibe ich Werte aus dem weiteren Blatt in Blatt1.
Blatt1 hat 500000 Zeilen.
Blatt Übersetzungen hat 100000 Zeilen.
Der Code arbeitet einwandfrei; einzig und alleine zu langsam; hat jemand Tuningideen?
'Zusatzangaben berechnen
Application.ScreenUpdating = False
e1=500000
For i1 = 2 To e1
If i1 Mod 100 = 0 Or i1 = e1 Then
Application.StatusBar = "Zusatzangaben ermitteln, Datensatz " & Format(i1, "0000000") & " von " & Format(e1, "0000000") & " Endzeit = " & Anfangszeit1 + (Now() - Anfangszeit1) / i1 * e1
DoEvents
End If
Sheets("Blatt1").Select
gn_such = Cells(i1, 4)
If gn_such "" Then
Sheets("Übersetzungen").Select
With Range("AQ:AQ")
Set c = .Find(gn_such, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
y = c.row
gn_configuration_id = Cells(y, 44)
Sheets(Blatt1).Select
Cells(i1, 6) = gn_configuration_id
End If
End With
End If
Next i1
Application.ScreenUpdating = True
Application.StatusBar = False
Vielen Dank für Hilfe!
Mit vorweihnachtlichen Grüßen,
Heinz

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Pseudo-Code

18.12.2018 17:02:27

Fennek

AW: Pseudo-Code

18.12.2018 18:08:38

Daniel

AW: Pseudo-Code

22.12.2018 18:40:43

Heinzs

AW: Suche beschleunigen

18.12.2018 17:31:21

Daniel

AW: Suche beschleunigen

18.12.2018 19:25:34

Sulprobil

AW: Suche beschleunigen

22.12.2018 18:43:30

Heinzs

AW: Suche beschleunigen

19.12.2018 01:25:26

Daniel

AW: Suche beschleunigen

22.12.2018 18:42:03

Heinzs

'--- Sortieren, falls erforderlich with Sheets("Übersetzungen") .usedrange.Sort Key1:=.Cells(1, 43), order1:=xlascending, Header:=xlguess end with '--- Suchen und einfügen With Sheets("Blatt1").Range("F2:F500000") .FormulaLocal = _ "=WENN(SVerweis(D2;Übersetzungen!AQ:AQ;1;1)=D2,SVerweis(D2;Übersetzungen!AQ:AR;2;1);"""") .Formula = .Value End with

Hi
mal drei Codevarianten, um die Aufgabe bei der gegebenen Datenmenge in kurzer Zeit zu lösen.
Makro VLU ist die von mir schon beschriebene Formelvariante mit dem SVerweis / VLookUp
Makro DoS basiert auf der Idee von Sulprobil mit der doppelten Sortierung
Makro Dic verwendet das Dictionary-Objekt.
die Makros wurden hier für Sheet(1) und Sheet(2) mit den Werten in Spalte A und B geschrieben.

Sub DoS()
Dim x1, x2, e1
Dim z1 As Long, z2 As Long
Sheets(1).UsedRange.Sort key1:=Sheets(1).Cells(1, 1), order1:=xlAscending, Header:=xlYes
Sheets(2).UsedRange.Sort key1:=Sheets(2).Cells(1, 1), order1:=xlAscending, Header:=xlYes
x1 = Sheets(1).UsedRange.Columns(1).Value
e1 = Sheets(1).UsedRange.Columns(2).Value
x2 = Sheets(2).UsedRange.Columns(1).Resize(, 2).Value
z2 = 1
For z1 = 2 To UBound(x1, 1)
If x1(z1, 1) = x1(z1 - 1, 1) Then
e1(z1, 1) = e1(z1 - 1, 1)
Else
For z2 = z2 To UBound(x2)
If x2(z2, 1) > x1(z1, 1) Then
If x2(z2 - 1, 1) = x1(z1, 1) Then
e1(z1, 1) = x2(z2 - 1, 2)
Else
e1(z1, 1) = ""
End If
Exit For
End If
Next
End If
Next
Sheets(1).UsedRange.Columns(2).Value = e1
End Sub

Sub VLU()
Sheets(2).UsedRange.Sort key1:=Sheets(2).Cells(1, 1), order1:=xlAscending, Header:=xlYes
With Sheets(1).UsedRange.Columns(2)
.FormulaR1C1 = "=If(VLookup(RC1,Tabelle2!C1,1,1)=RC1,VLookUp(RC1,Tabelle2!c1:c2,2,1),"""")"
.Copy
.PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Cells(1, 1).Value = "B"
End With
End Sub

Sub Dic()
Dim Dic As Object
Dim a, x
Dim z As Long
Set Dic = CreateObject("Scripting.dictionary")
a = Sheets(2).UsedRange.Columns(1).Resize(, 2)
For z = 2 To UBound(a, 1)
Dic(a(z, 1)) = a(z, 2)
Next
With Sheets(1).UsedRange.Columns(1)
a = .Value
For z = 2 To UBound(a, 1)
If Dic.exists(a(z, 1)) Then
a(z, 1) = Dic(a(z, 1))
Else
a(z, 1) = ""
End If
Next
a(1, 1) = "B"
.Offset(0, 1).Value = a
End With
End Sub

zu den Verarbeitungsgeschwindigkeiten:
getestet habe ich auf meinem Rechner mit 500.000 Zeilen in Tabelle1 und 100.000 Zeilen in Tabelle2
Dic: 8,2
VLU: 3,6
DoS: 4,3
nimmt man die Sortierung aus der Zeit heraus und geht davon aus, dass die Listen bereits passend sortiert sind, sehen die Zeiten so aus:
Dic: 5,2
VLU: 3,2
DoS: 1,9
überraschend ist für mich hier vor allem, dass auch die Dictionary-Methode durch die Sortierung deutlich schneller wird.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread