Excel VBA | Array & Dictionary | HERBERS Excel Forum

Servus zusammen,
ich habe ein kleines Excel VBA Problem, das vielleicht gar keines ist.
Die Subroutine sollte eigentlich nur 2 Datensätze vergleichen und den zweiten Datensatz vervollständigen und zurück in den Worksheet schreiben.
Zum Verständnis, in der Tabelle "MSRBSCell" stehen Parameter A & B, in der Tabelle "PUCell" stehen Parameter B & C.
Ergebnis am Ende, Tabelle "PUCell" mit Parameter A komplettieren und dann am Ende einen String generieren. (Die String Generation wird im Moment noch per Formel gelöst)
Das Problem ist eher die Menge der Daten.
MSRBScell = 220.000 Zeilen
PUCell = 270.000 Zeilen
Ein kompletter Durchlauf braucht im Moment 30min.
Wenn ich die Anzahl der Zeilen auf 10.000 reduziere läuft das Script 3 Sekunden.
bei 20.000 = 10s
bei 50.000 = 1:11 min
.
.
.
bei 250k = 30 min
Das Dictonary hab ich für dieses Script schon immer benutzt, die Array's sind neu. Geschwindigkeitsunterschied zu ohne Array geht richtung 0.
Vielleicht hat jemand von euch eine Idee.

PUCell_end = 20000 'PUCell.Cells(Rows.Count, 3).End(xlUp).Row + 1
MSRBSCell_end = 20000 'MSRBSCell.Cells(Rows.Count, 1).End(xlUp).Row
arrDict = MSRBSCell.Range("A2:D" & MSRBSCell_end).Value2
timetaken = Now()
For i = 1 To UBound(arrDict)
With Mydic1
On Error Resume Next:
.Add arrDict(i, 4), arrDict(i, 1)
If Err.Number  0 Then .Item arrDict(i, 4), arrDict(i, 1)
On Error GoTo 0
End With
Next i
arrDict = Empty
timetaken = Now() - timetaken
Debug.Print "Dict: ", timetaken
arrTest = PUCell.Range("B2:J" & PUCell_end).Value2
timetaken = Now()
For i = LBound(arrTest, 1) To UBound(arrTest, 1)
tmpNEID = arrTest(i, 4)
arrTest(i, 1) = Mydic1(tmpNEID)
Next i
PUCell.Range("B2:J" & PUCell_end) = arrTest
timetaken = Now() - timetaken
Debug.Print "Array & paste: ", timetaken
arrTest = Empty

Hi,
nach ein paar Testläufen bin ich auf folgendes gestossen.
Wenn ich beim füllen des Dictionary statt 1, 3 Stück befülle reduziert sich die Laufzeit um ~50%
Im 2. Schritt beim befüllen des 2. Arrays reduziert sich die Laufzeit auf 1/3 im Vergleich mit vorher.
Das Problem ohne die Prüfung dauert der durchlauf 10% länger. Anscheinend läuft da intern etwas wie das .exists weil wenn ich das zur Prüfung nutze dann dauerts genau so lange wie ohne.
Leider schreibt mir das auslesen der Daten aus dem Dictionary immer noch das Dictionary voll falls der key nicht existiert. (sieht man an den Items der 3 Dictionaries, weil im Step 2 wird ja eigenltich nur gelesen.)

Items:         36631
Items:         61693
Items:         112760
PUCell_Dict&Array_Step1:    00:05:13
Items:         45961
Items:         83757
Items:         130525
Step2         00:08:22

For i = 1 To UBound(arrdict)
tmpNEID = arrdict(i, 2)
Data = arrdict(i, 1)
If Left(tmpNEID, 2) = 44 Then
On Error Resume Next:
MyDic1.Add tmpNEID, Data
If Err.Number  0 Then MyDic1.Item(tmpNEID) = Data
On Error GoTo 0
End If
If Left(tmpNEID, 2) = 54 Then
On Error Resume Next:
MyDic2.Add tmpNEID, Data
If Err.Number  0 Then MyDic2.Item(tmpNEID) = Data
On Error GoTo 0
End If
If Left(tmpNEID, 2) = 64 Then
On Error Resume Next:
MyDic3.Add tmpNEID, Data
If Err.Number  0 Then MyDic3.Item(tmpNEID) = Data
On Error GoTo 0
End If
Next i

For i = 1 To UBound(arrTest, 1)
tmpNEID = arrTest(i, 2)
If Left(tmpNEID, 2) = 44 Then arrTest(i, 1) = MyDic1(tmpNEID)
If Left(tmpNEID, 2) = 54 Then arrTest(i, 1) = MyDic2(tmpNEID)
If Left(tmpNEID, 2) = 64 Then arrTest(i, 1) = MyDic3(tmpNEID)
next i

Excel VBA | Array & Dictionary

Forumthread: Excel VBA | Array & Dictionary

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Infobox / Tutorial

Excel VBA: Arbeiten mit Arrays und Dictionaries

Schritt-für-Schritt-Anleitung

Häufige Fehler und Lösungen

Alternative Methoden

Praktische Beispiele

Tipps für Profis

FAQ: Häufige Fragen

Beliebteste Forumthreads (12 Monate)