Hallo Zusammen,
Ich hab hier eine Arrayformel im VBA die verdammt langsam ist.
Sinn und zweck ist aus einem Variablem Tabellenblatt ein neues Blatt zu generieren, welches die Werte dann dort kumuliert nach max und min werten anzeigt.
Das funktioniert auch alles soweit, nur eben wahnsinnig langsam.
Im neuen Blatt steht dann der eindeutige wert in Spalte A und B und die dazugehörigen min und max Werte in E, F un G
Hier bsp. wie der Ursprung aussieht:
A B E F G
BAZN Name Fabrikat Nummer BEGINN ENDE
101 Rotamint Top+Jackpot 10100485 1983-04 1987-01
101 Rotamint Top+Jackpot 10101336 1983-06 1987-05
101 Rotamint Top+Jackpot 10101620 1983-05 x
101 Rotamint Top+Jackpot 10102064 x 1987-04
102 Rototron Rasant 102xxxxx x 1988-12
103 Rototron Titan 10300698 1983-10 x
103 Rototron Titan 10301976 1983-12 x
104 Merkur Bahia 10400921 x x
104 Merkur Bahia 10402849 1984-02 1988-01
106 Mister´X 10600503 1983-05 x
106 Mister´X 10600615 x x
106 Mister´X 10600744 1983-06 1987-05
und so sieht es nach dem Makro aus:
A B F G H I
BAZN Name Fabrikat Min F. Max G. Min aus E. Max aus E.
101 Rotamint Top+Jackpot 1983-04 1987-05 10100485 10102064
102 Rototron Rasant 0 1988-12 103 Rototron Titan 1983-10 10300698 10301976
104 Merkur Bahia 1984-02 1988-01 10400921 10402849
106 Mister´X 1983-05 1987-05 10600503 10600744
Calculation und Enable und ScreenUpdating ist auf Manuel bzw. False
Die If´s mit den ClearContents halfen auch nicht wirklich.
Dachte wenn ich unnötige bzw. leere Zellen gleich lösche bring das was.
hier mal ein Auszug vom Makro:
a = 2
Do Until IsEmpty(Cells(a, 1))
Cells(a, 6).Select
ActiveCell.FormulaArray = "=MIN(IF(((RC[-5]='" & strName & "'!C[-5])*(RC[-4]='" & strName & "'!C[-4])),'" & strName & "'!C[-0]))"
Cells(a, 7).Select
ActiveCell.FormulaArray = "=MAX(IF(((RC[-6]='" & strName & "'!C[-6])*(RC[-5]='" & strName & "'!C[-5])),'" & strName & "'!C[-0]))"
If Cells(a, 6).Text = "1900-01" Then Cells(a, 6).ClearContents Else Cells(a, 7).Select
If Cells(a, 7).Text = "1900-01" Then Cells(a, 7).ClearContents
Cells(a, 8).Select
ActiveCell.FormulaArray = "=MIN(IF(((RC[-7]='" & strName & "'!C[-7])*(RC[-6]='" & strName & "'!C[-6])),'" & strName & "'!C[-3]))"
If Cells(a, 8).Value = "0" Then Cells(a, 8).ClearContents Else Cells(a, 9).Select
ActiveCell.FormulaArray = "=MAX(IF(((RC[-8]='" & strName & "'!C[-8])*(RC[-7]='" & strName & "'!C[-7])),'" & strName & "'!C[-4]))"
If Cells(a, 9).Value = Cells(a, 8).Value Then Cells(a, 9).ClearContents
a = a + 1
Loop
End If
Next
Hoffe man kann erkennen was ich damit erreichen will und es hat mir jemand einen guten Tipp.
Danke schon mal
Gruß
Ghostman