Performantes Makro das Summewenn Formel ersetzt

Hallo Allerseits,
da ich immer mehr Performance Probleme habe, möchte ich gerne ein paar sehr "hungrige" Funktionen in Makros auslagern, die ich dann per Knopfdruck berechnen lassen kann.
Aktuell möchte ich, dass ein Makro mir folgende Funktion in Spalte N von N3 bis N10000 runterkopiert, dann die Resultate errechnet und dann die Resultate in Werte umwandelt und damit die Performance hungrigen Funktionen wieder verschwinden lässt:
=SUMMEWENN(G:G;G3;J:J)-SUMMEWENN(G:G;G3;L:L)+SUMMEWENN(G:G;G3;M:M)
Das habe ich mit dem Makro Rekorder soweit auch hinbekommen, aber es ist elendig langsam. Ich nehme an, dass es da eine viel schnellere Lösung gibt, bei der die Formel wirklich im Makro drinsteht und damit "echte" Makroberechnung stattfindet, anstatt wie bei mir einfach einen manuelle Kopieraktion zu automatisieren.
Weiß da jemand eine Lösung?
Vielen Dank und viele Grüße,
Martin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Sub mySummeWenn() Dim lngZ As Long, arQ, oDic As Object, zz As Long, arErg() As Double lngZ = Cells(Rows.Count, 7).End(xlUp).Row ' Länge der Spalte G arQ = Cells(1, 7).Resize(lngZ, 7) ' Spalten G:M Set oDic = CreateObject("Scripting.Dictionary") For zz = 1 To lngZ If oDic.Exists(arQ(zz, 1)) Then oDic(arQ(zz, 1)) = oDic(arQ(zz, 1)) _ + arQ(zz, 4) - arQ(zz, 6) + arQ(zz, 7) Else oDic.Add arQ(zz, 1), arQ(zz, 4) - arQ(zz, 6) + arQ(zz, 7) End If Next zz ReDim arErg(3 To lngZ, 0) ' Ergebnismatrix For zz = 3 To lngZ arErg(zz, 0) = oDic(arQ(zz, 1)) Next zz Cells(3, 14).Resize(lngZ - 2) = arErg ' Ausgabe ab N3 End Sub

Hallo Erich,
vielen Dank - ich habe gerade mal versucht das einzubauen. Leider bekomme ich einen Fehler - der Debugger sagt mir, dass folgende Zeile im Code falsch ist:
oDic.Add arQ(zz, 1), arQ(zz, 4) - arQ(zz, 6) + arQ(zz, 7)
Ich habe leider wirklich quasi gar keinen Durchblick bei Deinem Makro (sieht beeindruckend aus :)), deswegen habe ich keine Ahnung woran es liegen könnte.
Zwei Dinge allerdings:
ich habe mich bei einer Sache vertan: die Liste geht erst ab Zeile 9 und nicht Zeile 3 los (also die Ergebnisse sollen ab N9 angezeigt werden und die Summewenn Formel fängt er in Zeile 9 an:
In Spalte N Zeile 9 steht also =SUMMEWENN(G:G;G9;J:J)-SUMMEWENN(G:G;G9;L:L)+SUMMEWENN(G:G;G9;M:M)
In Spalte N Zeile 10 entsprechend: =SUMMEWENN(G:G;G10;J:J)-SUMMEWENN(G:G;G9;L:L)+SUMMEWENN(G:G;G10;M:M)
usw - bis in Spalte G nichts mehr steht.
Mein Makro war so unglaublich primitiv, dass ich mich kaum traue es hier rein zu kopieren. Ich habe die Formeln einfach als "Vorlage" in Zeile 3 stehen und das Makro macht nichts anderes, als diese ab Zeile 9 bis Zeile 10.000 zu kopieren und die Ergebnisse dann einfach in Werte umzuwandeln:
Range("N3").Select
Selection.Copy
Range("N9").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("N9:N10000")
Range("N9:N10000").Select
Range("N9").Select
Range("N9:N10000").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("N4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = ""
Range("N5").Select

Option Explicit Sub mySummeWenn_V2() Dim lngZ As Long, arQ, oDic As Object, zz As Long, arErg() As Double Const abZeile As Long = 3 ' Datenbeginn-Zeile vorgeben lngZ = Cells(Rows.Count, 7).End(xlUp).Row ' Länge der Spalte G If lngZ

Beliebteste Forumthreads (12 Monate)

Performantes Makro das Summewenn Formel ersetzt

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Performantes Makro das Summewenn Formel ersetzt

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

303 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread