Excel VBA | Array & Dictionary | HERBERS Excel Forum

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
naja, das übertragen der Daten zwischen Array und Zellbereich hin und zurück braucht auch Zeit.
ggf kannst du deinen Dictionary-Code beschleunigen, wenn du nur die tatsächlich benötigten Daten in Arrays übernimmst und nicht die komplette Tabelle:

arrTest = PUCell.Range("B2:J" & PUCell_end).Value2
PUCell.Range("B2:J" & PUCell_end) = arrTest

hier liest und schreibst du 9 Spalten, obwohl es jeweils ausreichen würde, eine Spalte zu lesen(E) und eine zu schreiben (B)
du betreibst einfach zu viel unnötigen Aufwand, weil du 8 nicht benötigte Datenspalten einliest und 8 nicht benötigte, weil unveränderte Datenspalten wieder zurückschreibst.
klar brauchst du dann zwei Arrays, eins mit den Quelldaten und eines mit den Ergebnisdaten, aber die brauchen dann zusammen nur 1/4 der Datenmenge, die du jetzt verwendest und zurückgeschrieben in den Zellbereich wird sogar nur 1/8.
ebenso ist die Erstellung deines Dictionarys unnötig aufwendig.
Warum erstellst du die WITH-Klammer in der Schleife jedes mal neu?
Innerhalb der Schleife sollten nur Sachen ausgeführt werden, die sich in der Schleife auch ändern.
Alles was in der Schleife gleich bleibt, sollte wenn möglich schon ausßerhalb der Schleife ausgefürhrt werden, damit es nicht unnötig wiederholt wird.
aber das hier sollte eigentlich reichen:

For i = 1 To UBound(arrDict)
Mydic1(arrDict(i, 4)) =  arrDict(i, 1)
Next i

Gruß Daniel

arrTest = PUCell.Range("E2:E" & PUCell_end).Value2 timetaken = Now() For i = LBound(arrTest, 1) To UBound(arrTest, 1) tmpNEID = arrTest(i, 1) arrTest(i, 1) = Mydic1(tmpNEID) Next i PUCell.Range("B2:B" & PUCell_end) = arrTest

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

Beliebteste Forumthreads (12 Monate)

Excel VBA | Array & Dictionary

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

49 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Excel VBA | Array & Dictionary

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

49 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread