Ungleiche zählen mit 2 Bedingungen?
Peter Schürer
XL2002.
Wir haben folgenden Aufbau:
Spalte A B E
01.03.10 1 TZE
01.03.10 1 TZE
01.03.10 1 TZE
01.03.10 1 TZE
01.03.10 1 QWH 27
01.03.10 1 QWH 27
01.03.10 2 11HBG
01.03.10 2 11HBG
01.03.10 2 RRR
01.03.10 2 HHGB
01.03.10 2 TZE
Ich brauche jetzt eine Formel, die zählt wie viele unterschiedliche
Werte in Spalte E bei gleichen Werten in A und B stehen.
Ergebnis:
01.03.10 1 2
01.03.10 2 4
Mit =SUMMENPRODUKT((Datum=$A4)*(Band=$B4)*(Model>0)) erhalte ich die Anzahl.
Ich habe schon alles versucht, entweder Fehler oder Anzahl.
Danke und Gruß
Peter
Claus Busch
Am Sun, 14 Mar 2010 15:38:59 +0100 schrieb Peter Sch�rer:
> Wir haben folgenden Aufbau:
>
> Spalte A B E
> 01.03.10 1 TZE
> 01.03.10 1 TZE
> 01.03.10 1 TZE
> 01.03.10 1 TZE
> 01.03.10 1 QWH 27
> 01.03.10 1 QWH 27
> 01.03.10 2 11HBG
> 01.03.10 2 11HBG
> 01.03.10 2 RRR
> 01.03.10 2 HHGB
> 01.03.10 2 TZE
>
> Ich brauche jetzt eine Formel, die z�hlt wie viele unterschiedliche
> Werte in Spalte E bei gleichen Werten in A und B stehen.
probiers mal so (Formel z�hlt beim ersten Vorkommen des Bandes, hier also
Zeile 2 und 8, falls du �berschriften hast. Formel geh�rt dann in Zelle
F2):
=WENN(Z�HLENWENN($B$2:B2;B2)=1;SUMME((VERGLEICH($A$2:$A$12&$B$2:$B$12&$E$2:$E$12;$A$2:$A$12&$B$2:$B$12&$E$2:$E$12;0)=ZEILE($1:$11)*($A$2:$A$12=A2)*($B$2:$B$12=B2)*($E$2:$E$12<>""))*1);"")
und mit STRG+Shift+Enter abschlie�en.
Eventuell Bez�ge anpassen.
Du k�nntest es auch mit einer Pivot-Tabelle l�sen. Datum und Modell in
Zeilenbereich, Band in Spaltenbereich und Modell nochmals in Wertebereich.
Mit freundlichen Gr�ssen
Claus Busch
--
Win XP PRof SP2 / Vista Ultimate SP2
Office 2003 SP2 /2007 Ultimate SP2
Peter Schürer
erst einmal vielen Dank für Deine Lösung.
Funktioniert auch gut, rechnet aber bei meinem Datenumfang sehr lange.
Ich habe eine Hilfsspalte eingefügt und dort eine Formel, die eine 1
einträgt wenn Spalte A und B gleich und E ungleich ist.
Danke und Gruß
Peter
Claus Busch schrieb:
> Hallo Peter,
>
> Am Sun, 14 Mar 2010 15:38:59 +0100 schrieb Peter Schürer:
>
>> Wir haben folgenden Aufbau:
>>
>> Spalte A B E
>> 01.03.10 1 TZE
>> 01.03.10 1 TZE
>> 01.03.10 1 TZE
>> 01.03.10 1 TZE
>> 01.03.10 1 QWH 27
>> 01.03.10 1 QWH 27
>> 01.03.10 2 11HBG
>> 01.03.10 2 11HBG
>> 01.03.10 2 RRR
>> 01.03.10 2 HHGB
>> 01.03.10 2 TZE
>>
>> Ich brauche jetzt eine Formel, die zählt wie viele unterschiedliche
>> Werte in Spalte E bei gleichen Werten in A und B stehen.
>
> probiers mal so (Formel zählt beim ersten Vorkommen des Bandes, hier also
> Zeile 2 und 8, falls du Überschriften hast. Formel gehört dann in Zelle
> F2):
> =WENN(ZÄHLENWENN($B$2:B2;B2)=1;SUMME((VERGLEICH($A$2:$A$12&$B$2:$B$12&$E$2:$E$12;$A$2:$A$12&$B$2:$B$12&$E$2:$E$12;0)=ZEILE($1:$11)*($A$2:$A$12=A2)*($B$2:$B$12=B2)*($E$2:$E$12<>""))*1);"")
> und mit STRG+Shift+Enter abschließen.
> Eventuell Bezüge anpassen.
> Du könntest es auch mit einer Pivot-Tabelle lösen. Datum und Modell in
> Zeilenbereich, Band in Spaltenbereich und Modell nochmals in Wertebereich.
>
>
> Mit freundlichen Grüssen
> Claus Busch
Bernd P
Das geht mit meinem Makro Pfreq, falls Du nicht zuviele Zeilen hast:
http://www.sulprobil.com/html/pfreq.html
Sonst gehts mit einer Abwandlung...
Wie viele Zeilen sind es denn?
Viele Gruesse,
Bernd
Peter Schürer
Bernd P schrieb:
noch sind es 986 Zeilen aber es werden mehr.
Pro Tag ca. 75 Zeilen +- mal 220 Arbeitstage = ca. 16500 Zeilen.
Das ganze muss auch noch schnell berechnet werden, da noch andere Werte
berechnet werden müssen.
>
> Viele Gruesse,
> Bernd
Danke und Gruß
Peter
Alexander Wolff
Anders als Bernd würde ich hier mit einer Sub statt einer Function arbeiten.
Bei 16500 Zeilen bist Du in weniger als 0,5 Sekunden damit durch.
--
Moin+Gruss Alexander - MVP for MS Excel - www.xxcl.de - mso2000sp3 --7-2
Alexander Wolff
Dim AA, BA
'Tabelle muss nach Spalte Z leer sein! Feldnamenzeile erwünscht!
Range("AA:AE").Value = Range("A:E").Value
'sortiert müsste nach Deinem Beispiel eigentlich nicht werden ...
Range("AA:AE").Sort Key1:=Range("AA2"), Order1:=xlAscending, _
Key2:=Range("AB2"), Order2:=xlAscending, Key3:=Range("AE2"), _
Order3:=xlAscending, Header:=xlGuess, OrderCustom:=1, _
MatchCase:=False, Orientation:=xlTopToBottom
'... machen wir aber sicherheitshalber doch
AA = Range("AA:AE")
BA = Range("BA:BE")
k = 1
For i = 2 To Range("AA:AE").Rows.Count
If AA(i, 2) <> AA(i - 1, 2) Or AA(i, 1) <> AA(i - 1, 1) Then
k = k + 1
BA(k, 1) = AA(i, 1)
BA(k, 2) = AA(i, 2)
BA(k, 5) = 1
Else
If AA(i, 5) <> AA(i - 1, 5) Then BA(k, 5) = BA(k, 5) + 1
End If
Next
Range("AA:AE") = BA
'der letzte Eintrag 1 in AE ist zu ignorieren
End Sub
Peter Schürer
das geht wie ein geölter Blitz.
Könntest Du vielleicht auch dieses Makro beschleunigen?
Sub DatSpeichern()
'[DatErf] = Datenerfassung
'[ProdDat] = Daten_2010
'Sicherstellen das wir im richtigen Sheet sind
[DatErf].Select
Z = [DatErf].Range("M5") 'Zähler für die Schleife wird gesetzt
PDat = ActiveSheet.Range("D3") 'Datum
PBand = ActiveSheet.Range("G3") 'Band
PSchicht = ActiveSheet.Range("J3") 'Schicht
With Application
.Calculation = xlManual
' .MaxChange = 0.001
End With
[ProdDat].Activate
For I = 1 To Z
' LetzteZelle
'beim aktivieren von ProdDat springt in die letzte leere Zelle in A
Application.ScreenUpdating = False
AZelle = [DatErf].Range("C" & I + 5) 'Erste Zelle im Datenbereich "Position"
ActiveCell.Value = PDat
ActiveCell.Offset(0, 1).Value = PBand
ActiveCell.Offset(0, 2).Value = PSchicht
ActiveCell.Offset(0, 3).Value = AZelle 'Wert aus C6 Stück Soll
ActiveCell.Offset(0, 4).Value = [DatErf].Range("C" & I +
5).Offset(0, 1).Value 'Modell
ActiveCell.Offset(0, 5).Value = [DatErf].Range("C" & I +
5).Offset(0, 2).Value 'Packteil
ActiveCell.Offset(0, 6).Value = [DatErf].Range("C" & I +
5).Offset(0, 3).Value 'Stück Ist
ActiveCell.Offset(0, 7).Value = [DatErf].Range("C" & I +
5).Offset(0, 4).Value 'MA Band
ActiveCell.Offset(0, 8).Value = [DatErf].Range("C" & I +
5).Offset(0, 5).Value 'P-Zeit
ActiveCell.Offset(0, 9).Value = [DatErf].Range("C" & I +
5).Offset(0, 6).Value 'TR
ActiveCell.Offset(0, 10).Value = [DatErf].Range("C" & I +
5).Offset(0, 7).Value 'ST
ActiveCell.Offset(0, 12).Value = [DatErf].Range("C" & I +
5).Offset(0, 8).Value 'MA Dispo
ActiveCell.Offset(0, 13).Value = [DatErf].Range("C" & I +
5).Offset(0, 9).Value 'MA Zulief.
ActiveCell.Offset(0, 14).Formula = "=TEXT(PDatum,""MMMM"")"
ActiveCell.Offset(0, 14).Copy
ActiveCell.Offset(0, 14).PasteSpecial xlPasteValues
ActiveCell.Offset(0, 1).Formula =
"=IF(AND(RC[-15]=R[-1]C[-15],RC[-14]=R[-1]C[-14],RC[-11]=R[-1]C[-11]),"""",1)"
ActiveCell.Offset(0, 1).Copy
ActiveCell.Offset(0, 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Application.ScreenUpdating = True
ActiveCell.Offset(1, -15).Activate
Next
[DatErf].Range("G3").ClearContents
[DatErf].Range("D3").ClearContents
[DatErf].Range("C6:J33").ClearContents
[DatErf].Select
Range("D3").Select
' With Application
' .Calculation = xlAutomatic
' .MaxChange = 0.001
' End With
End Sub
Danke und Gruß
Peter
Alexander Wolff schrieb:
Alexander Wolff
> das geht wie ein geölter Blitz.
> Könntest Du vielleicht auch dieses Makro beschleunigen?
[Makro gesnippt]
An meinem Makro kannst du sehen, wie man statt Excel-Zellen abzufragen und
neu einzeln zu befüllen, viel schneller mit VBA-Variablen (Arrays) rechnet:
Dim Pos 'ist eine Variant-Variable
Pos = Range("Position") 'wird durch die Zuweisung zu einem 2dim-Array
Pos(1, 1) = "irgendwas" 'welches mit Indizes = 1 beginnt
...
...
Am Ende aller Berechnungen gibst Du dann das VBA-Array als Block an den
Excel-Zellbereich zurück:
Range("Position") = Pos
Vorteil außerdem: Du gibst Werte statt Formeln zurück. Formeln werden immer
wieder neu gerechnet, Werte nur über VBA. Auch ist das Modell kleiner.
Andreas Killer
> Anders als Bernd würde ich hier mit einer Sub statt einer Function arbeiten.
> Bei 16500 Zeilen bist Du in weniger als 0,5 Sekunden damit durch.
Das liegt aber IMHO nicht daran das es eine Sub statt einer Function
ist.
Wenn ich Deine Sub bei mir laufen lasse, dann braucht sie rund 1
Sekunde für 16.500 Datensätze, der Unterschied wird wohl in der Art
der Daten sowie Rechnerqualität liegen. (Ein
Application.ScreenUpdating=False habe ich schon drin.)
Ich vermute mal das Du eine Sub bevorzugst weil Du in dieser sortieren
kannst?
Ein anderer Grund wäre das Excel-Limit, das man nur Array einer
bestimmten Größe mit einer Function in eine Tabelle zurückgeben kann.
Nun ja, wenn ich mal hergehe und einfach davon ausgehe das die Daten
sortiert sind, dann könnte man Sie nach Deiner Idee direkt
verarbeiten:
H1:J2 {=Test(A2:E16501)}
'H1 01.03.2010
'I1 1
'J1 2
'H2 01.03.2010
'I2 2
'J2 4
Function Test(Bereich) As Variant
Dim AA, BA, Res
Dim I As Long, K As Long
AA = Bereich
ReDim BA(1 To UBound(AA), 1 To 3)
K = 1
BA(K, 1) = AA(1, 1)
BA(K, 2) = AA(1, 2)
BA(K, 3) = 1
For I = 2 To UBound(AA)
If AA(I, 2) <> AA(I - 1, 2) Or AA(I, 1) <> AA(I - 1, 1) Then
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
BA(K, 3) = 1
Else
If AA(I, 5) <> AA(I - 1, 5) Then BA(K, 3) = BA(K, 3) + 1
End If
Next
'Der Übertrag ist wegen des Excel-Rückgabe-Limits nötig
ReDim Res(1 To K, 1 To 3)
For I = 1 To K
Res(I, 1) = BA(I, 1)
Res(I, 2) = BA(I, 2)
Res(I, 3) = BA(I, 3)
Next
Test = Res
End Function
Das ganze dauert etwa 0,1 bis 0,2 Sekunden. Also ist die längste Zeit
wohl das Kopieren/Sortieren.
Bernd verwendet in seiner Function ein Dictionary um zu bestimmen ob
die Werte schon da sind oder nicht. Auf Deine Idee umgemünzt sähe das
dann so aus:
Function Test2(Bereich) As Variant
Dim AA, BA, Res
Dim Key As String, Dict As Object, Dict2 As Object
Dim I As Long, J As Long, K As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
AA = Bereich
ReDim BA(1 To UBound(AA), 1 To 3)
For I = 1 To UBound(AA)
Key = AA(I, 1) & AA(I, 2)
If Not Dict.Exists(Key) Then
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
BA(K, 3) = 0
Dict.Add Key, K
Else
J = Dict.Item(Key)
Key = AA(I, 1) & AA(I, 2) & AA(I, 5)
If Not Dict2.Exists(Key) Then
BA(J, 3) = BA(J, 3) + 1
Dict2.Add Key, J
End If
End If
Next
ReDim Res(1 To K, 1 To 3)
For I = 1 To K
Res(I, 1) = BA(I, 1)
Res(I, 2) = BA(I, 2)
Res(I, 3) = BA(I, 3)
Next
Test2 = Res
End Function
Und dauert bei mir rund 0,4 Sekunden und bei Dir?
Andreas.
Peter Schleif
>
> Bernd verwendet in seiner Function ein Dictionary
Hätte ich instinktiv auch gemacht. Eine Dictionary ist IMHO die
einfachste Methode eine Liste unique zu machen und (optional) auch
Vorkommen zu zählen. Dict.Exists / Dict.Add kann man sich dabei übrigens
sparen.
Dict(key) = Dict(key) + 1
tut es auch um z.B. Häufigkeiten eines Schlüssels "key" zu zählen. Mit
For Each key In Dict.Keys
Debug.Print key, Dict(key)
Next
gibt man dann die key/count Paare aus oder schreibt sie in die Matrix.
Peter
Alexander Wolff
> On 14 Mrz., 22:00, "Alexander Wolff" <oo...@gmx.de> wrote:
>
>> Anders als Bernd würde ich hier mit einer Sub statt einer Function
>> arbeiten. Bei 16500 Zeilen bist Du in weniger als 0,5 Sekunden damit
>> durch.
> Das liegt aber IMHO nicht daran das es eine Sub statt einer Function
> ist.
Habe ich auch nicht behauptet.
> Wenn ich Deine Sub bei mir laufen lasse, dann braucht sie rund 1
> Sekunde für 16.500 Datensätze, der Unterschied wird wohl in der Art
> der Daten sowie Rechnerqualität liegen. (Ein
> Application.ScreenUpdating=False habe ich schon drin.)
Nein. Ich habe es schnell und schmutzig programmiert, nach dem Motto: Das
Wichtigste ist das Arbeiten innerhalb von VBA, ohne Excel. Bei mir werden
z.B. alle (65536) Zeilen eines Excelblatts getestet. Natürlich müsste man
jedoch dann abbrechen, sobald z.B. Datum = 0. Aber ich wollte vor allem erst
mal von Bernds 1 Minute runter.
> Ich vermute mal das Du eine Sub bevorzugst weil Du in dieser sortieren
> kannst?
Nein. Ich bin damit frei von Tabellen-Funktionen und kann allein anhand der
Anzahl der Werte eine Maßnahme variabel durchführen (was ich, wie oben
gerade zugegeben, nicht ausgenutzt habe). Und die Aufgabe des OP riecht für
mich danach, dass es eh nur Werte, keine Formeln, braucht. Und diese Werte
sollen manuell ermittelt werden. Und: Das Modell bleibt kleiner.
> Ein anderer Grund wäre das Excel-Limit, das man nur Array einer
> bestimmten Größe mit einer Function in eine Tabelle zurückgeben kann.
>
> Nun ja, wenn ich mal hergehe und einfach davon ausgehe das die Daten
> sortiert sind, dann könnte man Sie nach Deiner Idee direkt
> verarbeiten:
Bei mir kann dann einfach die Sort-Anweisung weg. Kopieren tu ich A:E auf
AA:AE nur, damit beides geht, Sort oder NoSort. Man könnte aber auch das
einsparen und mit den Originaldaten arbeiten.
> H1:J2 {=Test(A2:E16501)}
> 'H1 01.03.2010
> Das ganze dauert etwa 0,1 bis 0,2 Sekunden. Also ist die längste Zeit
> wohl das Kopieren/Sortieren.
Also meine vor der Erstellung vermuteten 0,5 Sekunden habe ich nicht
erreicht. Es waren eher 2 Sekunden. Leider habe ich grad meine Testdaten
nicht mehr, um Deine tolle Zeit zu erreichen. Das wäre dann ja noch mal eine
Größenordnung besser.
> Bernd verwendet in seiner Function ein Dictionary um zu bestimmen ob
> die Werte schon da sind oder nicht. Auf Deine Idee umgemünzt sähe das
> dann so aus:
Das kannte ich - als VBA-Laie - gar nicht. Ist aber eine schicke Idee.
> Function Test2(Bereich) As Variant
> Dim AA, BA, Res
> Dim Key As String, Dict As Object, Dict2 As Object
> Dim I As Long, J As Long, K As Long
> Set Dict = CreateObject("Scripting.Dictionary")
> Set Dict2 = CreateObject("Scripting.Dictionary")
> ...
> Und dauert bei mir rund 0,4 Sekunden und bei Dir?
Siehe oben fehlende Testdaten. Aber ich probiers aus.
Peter Schleif
>
Dito. 0,43 sec für 16500 Zeilen. Ich fülle am Ende noch mit "" auf um
die hässlichen #NV; bei zu großen Bereichen zu vermeiden.
ACHTUNG: Matrix-Funktion.
Eingabe mit <STRG> + <SHIFT> + <RETURN> abschließen!
=UngleicheZaehlen(A1:A16500;B1:B16500;E1:E16500)
Peter
Function UngleicheZaehlen(Bereich1, Bereich2, Bereich3) As Variant
Dim d As Object
Dim z As Long
Dim arr() As Variant
Dim key1 As Variant
Dim key2 As Variant
Set d = CreateObject("Scripting.Dictionary")
ReDim arr(1 To Application.Caller.Rows.Count)
For z = 1 To Bereich1.Rows.Count
key1 = Bereich1(z) & Bereich2(z)
key2 = Bereich3(z).Value
If Not d.Exists(key1) Then
d(key1) = Array(Bereich1(z), Bereich2(z), _
CreateObject("Scripting.Dictionary"))
End If
d(key1)(2)(key2) = d(key1)(2)(key2) + 1
Next
z = 1
For Each key1 In d.Keys
If z <= UBound(arr) Then
arr(z) = Array(d(key1)(0), d(key1)(1), d(key1)(2).Count)
End If
z = z + 1
Next
For z = z To UBound(arr)
arr(z) = Array("", "", "")
Next
UngleicheZaehlen = arr
End Function
Andreas Killer
> >> Anders als Bernd würde ich hier mit einer Sub statt einer Function
> >> arbeiten. Bei 16500 Zeilen bist Du in weniger als 0,5 Sekunden damit
> >> durch.
> > Das liegt aber IMHO nicht daran das es eine Sub statt einer Function
> > ist.
> Habe ich auch nicht behauptet.
Okay, dann hab ich das beim Lesen reininterpretiert, sorry.
> > Wenn ich Deine Sub bei mir laufen lasse, dann braucht sie rund 1
> > Sekunde für 16.500 Datensätze, der Unterschied wird wohl in der Art
> > der Daten sowie Rechnerqualität liegen. (Ein
> > Application.ScreenUpdating=False habe ich schon drin.)
Hmm, ich hab kein Application.EnableEvents =False gesagt, vielleicht
kommt daher die große Differenz.
> jedoch dann abbrechen, sobald z.B. Datum = 0. Aber ich wollte vor allem erst
> mal von Bernds 1 Minute runter.
:-)))
> > Und dauert bei mir rund 0,4 Sekunden und bei Dir?
> Siehe oben fehlende Testdaten. Aber ich probiers aus.
Okay, ich warte gebannt. :-))
Andreas.
Alexander Wolff
>>> Und dauert bei mir rund 0,4 Sekunden und bei Dir?
>> Siehe oben fehlende Testdaten. Aber ich probiers aus.
> Okay, ich warte gebannt. :-))
Schicke mir doch bitte mal Deine Mappe (ohne Testdaten) ... ich bekomme bei
beiden Formeln nur #WERT!, obwohl ich den Formelbereich markiert und ihn als
Arrayformel abgeschlossen habe. Der Fehler liegt sicher bei mir.
Meine Testdaten lauten:
A2: irgendein Datum
B2: irgendeine Zahl
E2: irgendeine Zahl
A3: =A2+GANZZAHL(ZUFALLSZAHL()*1,1)
B3: =GANZZAHL(ZUFALLSZAHL()*3,5)
E3: =GANZZAHL(ZUFALLSZAHL()*2)
A3:E3: runterzukopieren und plattzumachen
Nochmal zu meiner Sub:
3,0 GHz Pentium 4 (von 2004), 512 MB
16500 Sätze: 2,2 Sekunden
65535 Sätze: 4,0 Sekunden
Das bedeutet für 16500 Sätze ohne Vorbereitung 0,6 Sekunden. Das Drumrum
(Sort, Zuweisungen, kein Bildschirm-Aus) braucht 1,6 Sekunden.
Andreas Killer
> Schicke mir doch bitte mal Deine Mappe (ohne Testdaten) ... ich bekomme
> bei beiden Formeln nur #WERT!, obwohl ich den Formelbereich markiert und
> ihn als Arrayformel abgeschlossen habe. Der Fehler liegt sicher bei mir.
Wahrscheinlich ist Deine Arrayformel zu groß, probier mal die Formel
nur über einen Bereich von ein paar hundert Zeilen, dann bekommst Du
Werte.
Excel 2000 (spätere Versionen auch?) hat hier ein Limit bei der
Rückgabe, das Array wird einfach nicht mehr in die Tabelle
eingetragen, obwohl es in der Function korrekt verarbeitet wird.
Andreas.
Alexander Wolff
> Nochmal zu meiner Sub:
> 3,0 GHz Pentium 4 (von 2004), 512 MB
> 16500 Sätze: 2,2 Sekunden
> 65535 Sätze: 4,0 Sekunden
>
> Das bedeutet für 16500 Sätze ohne Vorbereitung 0,6 Sekunden. Das
> Drumrum (Sort, Zuweisungen, kein Bildschirm-Aus) braucht 1,6 Sekunden.
Das scheint von mir nicht richtig gedeutet. Die zeitl. Eingrenzung auf den
Codeteil
------------------------------------------------------------------------
K = 1
For I = 2 To Range("AA:AE").Rows.Count
If AA(I, 2) <> AA(I - 1, 2) Or AA(I, 1) <> AA(I - 1, 1) Then
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
BA(K, 5) = 1
Else
If AA(I, 5) <> AA(I - 1, 5) Then BA(K, 5) = BA(K, 5) + 1
End If
Next
------------------------------------------------------------------------
dauert bei 65535 gefüllten Zeilen nur 0,07 bis 0,12 Sekunden (das Problem
läßt sich vor xl2007 leider nicht auf mehr Zeilen bringen, daher diese große
Ungenauigkeit). Diese Zeit muss eigentlich verglichen werden, evtl. ergänzt
um den Sort, da das Dictionary dafür die Vergleichshandlung ist.
Die abschließende Zuweisung und Bildschirmaktualisierung dauern dann im
Bereich von 1 Sekunde. Wobei das Füllen von mehr Zellen auch länger dauert,
auch wenn die Blockgröße gleich groß ist.
Die Umkehrung des IF (hier:)
------------------------------------------------------------------------
If AA(I, 2) = AA(I - 1, 2) And AA(I, 1) = AA(I - 1, 1) Then
If AA(I, 5) <> AA(I - 1, 5) Then BA(K, 5) = BA(K, 5) + 1
Else
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
BA(K, 5) = 1
End If
------------------------------------------------------------------------
bringt anscheinend keine Beschleunigung.
Alexander Wolff
Stimmt wohl (hierzu keine eindeutige Antwort von www.xlam.ch).
Wieder ein Grund mehr für eine Sub :-)
Peter Schleif
>
> A2: irgendein Datum
> B2: irgendeine Zahl
> E2: irgendeine Zahl
> A3: =A2+GANZZAHL(ZUFALLSZAHL()*1,1)
> B3: =GANZZAHL(ZUFALLSZAHL()*3,5)
> E3: =GANZZAHL(ZUFALLSZAHL()*2)
>
> 16500 Sätze: 2,2 Sekunden
Ich habe jetzt mal deine Formeln benutzt um Test-Daten zu erzeugen und
meinen Code darauf angewendet. Interessanterweise habe ich identische
Laufzeiten (2,3 sec bei 16500 Zeilen), obwohl ich ein ganz anderes
System habe und einen völlig anderen Lösungsansatz. Könntest Du evtl.
mal meine Mappe bei Dir laufen lassen und die Laufzeit posten?! Vielen
Dank im Voraus.
http://home.arcor.de/peter.schleif/Leistungsinformationen.pdf
http://home.arcor.de/peter.schleif/UngleicheZaehlen.xls
Peter
Peter Schleif
>
Die liefert bei mir falsche Ergebnisse – egal ob sortiert oder nicht.
Vielleicht mache ich aber auch beim Aufruf etwas falsch. Hier die ersten
10 Zeilen der Test-Daten, die ich mit Alexanders Formel erzeugt habe und
die Aufrufe der Funktionen "Test2" und "UngleicheZaehlen" - jeweils als
drei-spaltige Matrix-Funktion
=Test2(A1:E10)
=UngleicheZaehlen(A1:A10;B1:B10;E1:E10)
Peter
Test-Daten (sortiert A,B,E)
+------------+-----+-----+-----+-----+
| A | B | C | D | E |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 0 | | | 7 |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 1 | | | 3 |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 1 | | | 8 |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 1 | | | 8 |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 1 | | | 9 |
+------------+-----+-----+-----+-----+
| 01.03.2010 | 3 | | | 4 |
+------------+-----+-----+-----+-----+
| 02.03.2010 | 0 | | | 9 |
+------------+-----+-----+-----+-----+
| 02.03.2010 | 2 | | | 2 |
+------------+-----+-----+-----+-----+
| 03.03.2010 | 0 | | | 3 |
+------------+-----+-----+-----+-----+
| 03.03.2010 | 0 | | | 6 |
+------------+-----+-----+-----+-----+
Test2 UngleicheZaehlen
+------------+-----+-----+ +------------+-----+-----+
| 01.03.2010 | 0 | 0 | | 01.03.2010 | 0 | 1 |
+------------+-----+-----+ +------------+-----+-----+
| 01.03.2010 | 1 | 2 | | 01.03.2010 | 1 | 3 |
+------------+-----+-----+ +------------+-----+-----+
| 01.03.2010 | 3 | 0 | | 01.03.2010 | 3 | 1 |
+------------+-----+-----+ +------------+-----+-----+
| 02.03.2010 | 0 | 0 | | 02.03.2010 | 0 | 1 |
+------------+-----+-----+ +------------+-----+-----+
| 02.03.2010 | 2 | 0 | | 02.03.2010 | 2 | 1 |
+------------+-----+-----+ +------------+-----+-----+
| 03.03.2010 | 0 | 1 | | 03.03.2010 | 0 | 2 |
+------------+-----+-----+ +------------+-----+-----+
| #NV | #NV | #NV | | | | |
+------------+-----+-----+ +------------+-----+-----+
| #NV | #NV | #NV | | | | |
+------------+-----+-----+ +------------+-----+-----+
| #NV | #NV | #NV | | | | |
+------------+-----+-----+ +------------+-----+-----+
| #NV | #NV | #NV | | | | |
+------------+-----+-----+ +------------+-----+-----+
Alexander Wolff
Das ist eigentlich ganz simpel:
Maßgebend ist der Takt (wenn ansonsten Architektur gleich).
Duo- oder Quad- bringt heute noch gar nichts, vielleicht aber ab xl2007 (ich
weiß grad nicht, wann Mehrprozessoren unterstützt sind).
Die VBA-Aufgabe jedoch ist strikt sequentiell und daher sowieso niemals
nicht verteilbar.
> http://home.arcor.de/peter.schleif/UngleicheZaehlen.xls
Bei mir zeigt Deine MsgBox 2,7 Sekunden an. Allerdings gelingt aus den
vorher im Thread angegebenen Gründen auch bei Deiner Tabelle bei mir
(xl2000) keine Funktionswert-Rückgabe (#WERT!). Die Berechnung selbst wird
jedoch ohne Fehler durchgeführt.
Läuft Dein Windows-Excel direkt unter dem Mac-OS? Dann ist das Ergebnis ja
bemerkenswert! Ich vermute, dass andere Komponenten bei mir einfach viel
langsamer sind (RAM, Cache). Also: 15% schneller bei 15% langsamerem
Prozessor + ?% möglicher Nachteil ggü echtem Windows =~ 30% Vorteil bei den
restlichen Komponenten.
Peter Schleif
Vielen Dank fürs Testen!
Alexander Wolff schrieb am 16.Mrz.2010 09:54 Uhr:
>
> Maßgebend ist der Takt (wenn ansonsten Architektur gleich).
> Duo- oder Quad- bringt heute noch gar nichts, vielleicht aber ab xl2007
Sicher?
Wenn ich unter Win7 (64-bit) den Taskmanager in den Vordergrund hole und
beim Start der Function die EKG-Kurven der beiden Prozessor-Kerne
beobachte, dann gehen _beide_ gleichzeitig für 2-3 Sekunden hoch und
kommen auch _beide_ gleichzeitig wieder runter. Und ich habe ja auch nur
xl2002.
> Die VBA-Aufgabe jedoch ist strikt sequentiell und daher sowieso niemals
> nicht verteilbar.
Hmmmm. Wenn aufeinanderfolgende Berechnungen nicht voneinander abhängen,
kann Excel doch den Prozessor mit Rechnen-Aufgaben bombadieren ohne
jeweils auf das Ergebnis der vorhergehenden Operation warten zu müssen.
Und die CPU könnte die Berechnungen dann verteilen wie sie möchte.
Verstehe davon aber definitiv zu wenig, um mehr als eine Vermutung
abgeben zu können.
> Läuft Dein Windows-Excel direkt unter dem Mac-OS?
Neee. Ganz normales natives Windows7x64 mit dem alten Office XP. Die
Mac-OS-Partition benutze ich gar nicht. Habe keine Lust nach so vielen
Jahren Windows noch mal umzuschulen.
> Ich vermute, dass andere Komponenten bei mir einfach viel
> langsamer sind (RAM, Cache). Also: 15% schneller bei 15% langsamerem
> Prozessor + ?% möglicher Nachteil ggü echtem Windows =~ 30% Vorteil bei den
> restlichen Komponenten.
Wie gesagt: Ich könnte mir auch vorstellen, dass Win7 es doch irgendwie
schafft, zumindest einen Teil der Aufträge auf beide Kerne zu verteilen.
Peter
Alexander Wolff
> Vielen Dank fürs Testen!
>
> Alexander Wolff schrieb am 16.Mrz.2010 09:54 Uhr:
>>
>> Maßgebend ist der Takt (wenn ansonsten Architektur gleich).
>> Duo- oder Quad- bringt heute noch gar nichts, vielleicht aber ab
>> xl2007
>
> Sicher?
>
> Wenn ich unter Win7 (64-bit) den Taskmanager in den Vordergrund hole
> und beim Start der Function die EKG-Kurven der beiden Prozessor-Kerne
> beobachte, dann gehen _beide_ gleichzeitig für 2-3 Sekunden hoch und
> kommen auch _beide_ gleichzeitig wieder runter. Und ich habe ja auch
> nur xl2002.
Dann liegt das am Win7, welches mehrere (?) Prozesse unterstützt. Das kann
ja z.B. auch Excel vs. den Rest sein. Aber unser VBA-Makro kann bis in alle
Ewigkeit nur sequentiell ablaufen. Es müsste dann schon völlig umcodiert
werden.
>> Die VBA-Aufgabe jedoch ist strikt sequentiell und daher sowieso
>> niemals nicht verteilbar.
>
> Hmmmm. Wenn aufeinanderfolgende Berechnungen nicht voneinander
Tun sie aber hier.
> abhängen, kann Excel doch den Prozessor mit Rechnen-Aufgaben
> bombadieren ohne jeweils auf das Ergebnis der vorhergehenden
> Operation warten zu müssen. Und die CPU könnte die Berechnungen dann
> verteilen wie sie möchte. Verstehe davon aber definitiv zu wenig, um
> mehr als eine Vermutung abgeben zu können.
>
>> Läuft Dein Windows-Excel direkt unter dem Mac-OS?
>
> Neee. Ganz normales natives Windows7x64 mit dem alten Office XP. Die
> Mac-OS-Partition benutze ich gar nicht. Habe keine Lust nach so vielen
> Jahren Windows noch mal umzuschulen.
Dann könnte ich mir ja auch mal nen Mac kaufen ...
>> Ich vermute, dass andere Komponenten bei mir einfach viel
>> langsamer sind (RAM, Cache). Also: 15% schneller bei 15% langsamerem
>> Prozessor + ?% möglicher Nachteil ggü echtem Windows =~ 30% Vorteil
>> bei den restlichen Komponenten.
>
> Wie gesagt: Ich könnte mir auch vorstellen, dass Win7 es doch
> irgendwie schafft, zumindest einen Teil der Aufträge auf beide Kerne
> zu verteilen.
nein, s.o. Was gehen müsste, ist das Zurückschreiben der VBA-Werte in
Excel-Zellen, ja (und der entsprechende Hinweg auch). Das macht tatsächlich
auch einen viel größeren Zeitanteil aus (1 Sek.), als die VBA-Berechnungen
(0,1 Sek.). Von daher hast Du recht.
Peter Schleif
>
> Dann liegt das am Win7, welches mehrere (?) Prozesse unterstützt. Das kann
> ja z.B. auch Excel vs. den Rest sein. Aber unser VBA-Makro kann bis in alle
> Ewigkeit nur sequentiell ablaufen. Es müsste dann schon völlig umcodiert
> werden.
Du hast recht. Kann mit auch nicht vorstellen, dass das alte xl2002 in
der Lage ist, Befehle "vorausschauend" abzuarbeiten.
> Dann könnte ich mir ja auch mal nen Mac kaufen ...
Kann ich nur empfehlen. Mit den aktuellen BootCamp lässt sich Win7 bei
mir problemlos installieren und betreiben. Und so ein MacBook sieht halt
auch einfach gut aus....
> Was gehen müsste, ist das Zurückschreiben der VBA-Werte in
> Excel-Zellen, ja (und der entsprechende Hinweg auch). Das macht tatsächlich
> auch einen viel größeren Zeitanteil aus (1 Sek.), als die VBA-Berechnungen
> (0,1 Sek.).
Bei mir gehen 90% der Zeit der Function für die erste For-Schleife drauf
in der das Dictionary aufgebaut wird. Das Füllen des Rückgabe-Array und
schreiben der Werte in die Zellen fällt kaum ins Gewicht – wobei ich
letzteres nur subjektiv "messen" kann.
Wie kann man die Zeit messen, die vom Ende der Function vergeht, bis
alle Zellen gefüllt sind?
Peter
Andreas Killer
> > Function Test2(Bereich) As Variant
> Die liefert bei mir falsche Ergebnisse – egal ob sortiert oder nicht.
Ja, stimmt, hab ich nicht so genau hingekuckt, ich mach mal eine
Test3, die liefert die gleichen Ergebnisse.
Function Test3(Bereich) As Variant
Dim AA, BA, Res
Dim Key As String
Dim Dict As Object, Dict2 As Object
Dim I As Long, J As Long, K As Long
Set Dict = CreateObject("Scripting.Dictionary")
Set Dict2 = CreateObject("Scripting.Dictionary")
AA = Bereich
ReDim BA(1 To UBound(AA), 1 To 3)
For I = 1 To UBound(AA)
Key = AA(I, 1) & AA(I, 2)
If Not Dict.Exists(Key) Then
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
Dict.Add Key, K
Key = AA(I, 1) & AA(I, 2) & AA(I, 5)
Dict2.Add Key, K
BA(K, 3) = 1
Else
J = Dict.Item(Key)
Key = AA(I, 1) & AA(I, 2) & AA(I, 5)
If Not Dict2.Exists(Key) Then
Dict2.Add Key, J
BA(J, 3) = BA(J, 3) + 1
End If
End If
Next
ReDim Res(1 To K, 1 To 3)
For I = 1 To K
Res(I, 1) = BA(I, 1)
Res(I, 2) = BA(I, 2)
Res(I, 3) = BA(I, 3)
Next
Test3 = Res
End Function
Wenn ich nun die gesammelten Routinen auf meinem Rechner mit Deinen
Testdaten laufen lassen, dann benötigen Sie diese Zeiten:
0,06094 Function Test
0,39732 Function Test3
3,35854 Function UngleicheZaehlen
1,09960 Sub Frequency_Schuerer (mit sortieren)
1,05755 Sub Frequency_Schuerer (ohne sortieren)
Wobei man allerdings berücksichtigen muss das für Function Test die
Daten sortiert sein müssen um korrekte Ergebnisse zu erhalten. Das
Screenupdating sowie Events sind bei allen Routinen vorher
ausgeschaltet.
Damit ich UngleicheZaehlen messen konnte musste ich die Zeile
ReDim arr(1 To Application.Caller.Rows.Count)
in
ReDim arr(1 To Bereich1.Rows.Count)
ändern, da ich die Zeiten in/mit VBA messe:
Sub Call_Test()
Dim Data
Data = Test(Range("A1:E16500"))
End Sub
Sub Call_Test3()
Dim Data
Data = Test3(Range("A1:E16500"))
End Sub
Sub Call_UngleicheZaehlen()
Dim Data
Data = UngleicheZaehlen(Range("A1:A16500"), Range("B1:B16500"),
Range("E1:E16500"))
End Sub
Sub Call_Frequency_Schuerer()
Frequency_Schuerer
End Sub
Die gravierenden Zeitabweichungen kommen IMHO durch die verwendeten
Zugriffe auf Range's zustande, Test und Test3 greifen ja nur am Anfang
auf einen Range zu.
BTW, es gibt da noch ein Zeitfenster / Problem / Phenomen:
Um die Ergebnisse vergleichen zukönnen hab ich mal diese Routine
gebastelt:
Sub ValidateData()
Dim Data1, Data2
Dim Y As Long, X As Long, T As Single
Data1 = UngleicheZaehlen(Range("A1:A16500"), Range("B1:B16500"),
Range("E1:E16500"))
Data2 = Test3(Range("A1:E16500"))
T = Timer
Range("G1").Resize(UBound(Data1), 3) = Data1
MsgBox Timer - T
T = Timer
Range("K1").Resize(UBound(Data2), 3) = Data2
MsgBox Timer - T
End Sub
Und dann ganz erstaunt festgestellt das in Spalte G-I überhaupt keine
Daten ankommen und länger dauert es auch noch. Hast Du eine Erklärung
dafür warum das nicht geht? Die UDF ist doch die gleiche?
Andreas.
Andreas Killer
> dauert bei 65535 gefüllten Zeilen nur 0,07 bis 0,12 Sekunden (das Problem
Ist korrekt, das kann ich so nachvollziehen.
> Die abschließende Zuweisung und Bildschirmaktualisierung dauern dann im
> Bereich von 1 Sekunde. Wobei das Füllen von mehr Zellen auch länger dauert,
> auch wenn die Blockgröße gleich groß ist.
Ja, auch das kann ich so bestätigen.
> Die Umkehrung des IF (hier:)
...
> bringt anscheinend keine Beschleunigung.
Nein, ich finde es immer interessant was für eine riesige Menge an
Instruktionen eine CPU in Bruchteilen einer Sekunde ausführen.
Also bleibt es so wie immer: Nicht auf Range's zugreifen/reinschreiben
sondern nur in's Array geht am schnellsten.
Andreas.
Peter Schleif
>
> Ja, stimmt, hab ich nicht so genau hingekuckt, ich mach mal eine
> Test3, die liefert die gleichen Ergebnisse.
>
> Function Test3(Bereich) As Variant
Funktioniert! Und ist schnell.
> 0,06094 Function Test
> 0,39732 Function Test3
> 3,35854 Function UngleicheZaehlen
> 1,09960 Sub Frequency_Schuerer (mit sortieren)
> 1,05755 Sub Frequency_Schuerer (ohne sortieren)
>
> Die gravierenden Zeitabweichungen kommen IMHO durch die verwendeten
> Zugriffe auf Range's zustande, Test und Test3 greifen ja nur am Anfang
> auf einen Range zu.
Neee. Ich hatte die Ranges schon mal gegen Daten-Arrays ausgetauscht -
bringt nicht viel. Meine Lösung ist so langsam, weil ich für _jeden_
Eintrag im ersten/äußeren Dictionary ein weiteres Sub-Dictionary anlege.
Bei meinen zuletzt verwendeten Testdaten waren das 4538 CreateObjects.
Das ist unglaublich teuer und ganz offensichtlich keine gute Idee.
Werde darum nachher im Zug mal deine Lösung "Test3" durcharbeiten. Sieht
aus, als könnte ich da was lernen.
> Data1 = UngleicheZaehlen(Range("A1:A16500"), Range("B1:B16500"),
> Range("E1:E16500"))
> Range("G1").Resize(UBound(Data1), 3) = Data1
>
> Und dann ganz erstaunt festgestellt das in Spalte G-I überhaupt keine
> Daten ankommen und länger dauert es auch noch. Hast Du eine Erklärung
> dafür warum das nicht geht? Die UDF ist doch die gleiche?
Weil ich kein echtes 2-dimensionales Array verwende. Vielmehr ist arr
ein 1-dimensionales Array dessen Einträge wiederum 1-dimensionale,
3-elementige Arrays sind. Excel stört das bei der direkten Übernahme in
die Zellen nicht; VBA hingegen schon.
arr(z) = Array(d(key1)(0), d(key1)(1), d(key1)(2).Count)
arr(z) = Array("", "", "")
ist halt kürzer als
arr(z, 0) = d(key1)(0)
arr(z, 1) = d(key1)(1)
arr(z, 2) = d(key1)(2).Count
arr(z, 0) = ""
arr(z, 1) = ""
arr(z, 2) = ""
Peter
Andreas Killer
>> Die gravierenden Zeitabweichungen kommen IMHO durch die verwendeten
>> Zugriffe auf Range's zustande, Test und Test3 greifen ja nur am Anfang
>> auf einen Range zu.
> Neee. Ich hatte die Ranges schon mal gegen Daten-Arrays ausgetauscht -
> bringt nicht viel. Meine Lösung ist so langsam, weil ich für _jeden_
Also ich hatte schon mal das probiert:
Sub TestArray()
Dim Data, I As Long, J As Long
Data = Range("A1:C65536")
For I = 1 To UBound(Data)
For J = 1 To UBound(Data, 2)
If Data(I, J) = 0 Then
End If
Next
Next
End Sub
Sub TestRange()
Dim R As Range, I As Long, J As Long
Set R = Range("A1:C65536")
For I = 1 To R.Rows.Count
For J = 1 To R.Columns.Count
If R(I, J) = 0 Then
End If
Next
Next
End Sub
Die sind ja ziemlich identisch, oder?
Starte die mal im VBA-Editor mit F5 und kuck mal oben in die
Titelzeile wie lange Du [aktiv] sehen kannst. Bei der Array-Variante
flackert es nur kurz, bei Range reicht es (auf meinem Rechner) für den
Griff zur Kaffeetasse. :-))
> Eintrag im ersten/äußeren Dictionary ein weiteres Sub-Dictionary anlege.
> Bei meinen zuletzt verwendeten Testdaten waren das 4538 CreateObjects.
> Das ist unglaublich teuer und ganz offensichtlich keine gute Idee.
Au Backe, ja, hatte ich gar nicht gesehen. Klar das wird die wohl die
meiste Zeit verbraten.
> Werde darum nachher im Zug mal deine Lösung "Test3" durcharbeiten. Sieht
> aus, als könnte ich da was lernen.
Ist Alexander's Idee ich hab nur die Dictonary's drangefummelt. :-)
> Weil ich kein echtes 2-dimensionales Array verwende. Vielmehr ist arr
> ein 1-dimensionales Array dessen Einträge wiederum 1-dimensionale,
> 3-elementige Arrays sind. Excel stört das bei der direkten Übernahme in
> die Zellen nicht; VBA hingegen schon.
Hmm, tja, naja, ich frage mich halt ob das zeitlich gesehen eine Rolle
spielt.... aber das läßt sich wohl nicht messen oder?
Andreas.
Michael Schwimmer
On Tue, 16 Mar 2010 04:00:52 -0700 (PDT), Andreas Killer wrote:
> Set Dict = CreateObject("Scripting.Dictionary")
warum verwendest du hier das Dictionary-Objekt?
Nicht nur die Objekterstellung dauert, auch der Zugriff auf die
einzelnen Elemente ist recht langsam.
Eine Collection ist Bestandteil von VBA und ist auch erheblich
schneller als das Dictionary-Objekt. Wenn man wissen m?chte, ob ein
Objekt existiert, schaltet man die Fehlerbehandlung ein, setzt das
Err-Objekt zur?ck und greift auf das gew?nschte Element zu. Bei einem
Fehler existiert das Objekt noch nicht. Selbst das Zur?cksetzen, das
Zugreifen auf das Element und das Auswerten des Err-Objektes ist fast
achtmal schneller, als das Anwenden der Exist-Methode.
Wenn Zeit also eine Rolle spielt, sollte man auf die gute, alte
Collection zur?ckgreifen.
Hier mal ein paar Zeiten zum Vergleich mit ?hnlichem Code (die
absolute Zeit ist dabei uninteressant):
objDict.Add : 00:17
objDict.Exists : 00:17
objDict.Remove : 00:17
objCol.Add : 00:06
objCol.Exists (?ber das Error Objekt): 00:03
objCol.Remove : 00:02
Die Remove-Methode beim Dictionary-Objekt kann die Performance
?brigens schnell auf den Nullpunkt bringen, wenn man Elemente in
anderen Reihenfolgen entfernt, als sie hineingeschrieben wurden, ich
habe bei einigen Tests mit 456976 Elementen entnervt aufgegeben.
Wenn der Zugriff nicht mehr ?ber die iUnknown-Schnittstelle l?uft,
wird es sicherlich noch etwas besser, ich mag aber Verweise auf fremde
Objekte nicht besonders.
Viele Gr??e
Michael
Peter Schleif
>
> Bei der Array-Variante
> flackert es nur kurz, bei Range reicht es (auf meinem Rechner) für den
> Griff zur Kaffeetasse. :-))
Schon klar. Der Unterschied zwischen Daten-Array und Range war aber in
dem Fall vernachlässigbar gegenüber der CreateObject-Problematik. Der
Laufzeit-Unterschied war zwar messbar, änderte aber nichts an der
katastrophalen Größenordnung durch die 4538-fache Dictionary-Erzeugung.
> Hmm, tja, naja, ich frage mich halt ob das zeitlich gesehen eine Rolle
> spielt.... aber das läßt sich wohl nicht messen oder?
Wozu sollte man es messen? Es werden vielleicht ein paar Millisekunden
sein. Deswegen mache ich mir keine Gedanken. Ob eine Function nun 0,16
oder 0,17 sec läuft ist doch egal. Problematisch wird es erst, wenn man
einen schlimmen konzeptionellen Fehler hat, wie mein Code.
Das Gleiche gilt für [A1:A10] statt Range("A1:A10"). Irgendjemand hat
mir mal empfohlen, nicht die Evaluate- bzw. []-Schreibweise zu
verwenden, weil sie 1/3 langsamer. Na und? Statt 0,000003 Sekunden
braucht der Interpreter also 0,000004 Sekunden. Ich werte den Ausdruck
ja nicht 100000x aus.
Peter
Andreas Killer
>> Set Dict = CreateObject("Scripting.Dictionary")
> warum verwendest du hier das Dictionary-Objekt?
> Nicht nur die Objekterstellung dauert, auch der Zugriff auf die
> einzelnen Elemente ist recht langsam.
>
> Eine Collection ist Bestandteil von VBA und ist auch erheblich
> schneller als das Dictionary-Objekt. Wenn man wissen m?chte, ob ein
> Objekt existiert, schaltet man die Fehlerbehandlung ein, setzt das
> Err-Objekt zur?ck und greift auf das gew?nschte Element zu. Bei einem
> Fehler existiert das Objekt noch nicht. Selbst das Zur?cksetzen, das
> Zugreifen auf das Element und das Auswerten des Err-Objektes ist fast
> achtmal schneller, als das Anwenden der Exist-Methode.
Hmm, coole Idee, kann ich aber nicht bestätigen:
Running 10 tests with 1 timings for 1 calls of 'Call_Test3'
Starttime 16.03.2010 18:25:23
01. Short 0,38798 Long 0,38798 Average 0,38798
02. Short 0,43608 Long 0,43608 Average 0,43608
03. Short 0,39827 Long 0,39827 Average 0,39827
04. Short 0,43282 Long 0,43282 Average 0,43282
05. Short 0,40529 Long 0,40529 Average 0,40529
06. Short 0,43180 Long 0,43180 Average 0,43180
07. Short 0,40746 Long 0,40746 Average 0,40746
08. Short 0,43008 Long 0,43008 Average 0,43008
09. Short 0,40405 Long 0,40405 Average 0,40405
10. Short 0,43091 Long 0,43091 Average 0,43091
Result:
00. Short 0,43091 Long 0,43091 Average 0,41647
Endtime 16.03.2010 18:25:27
Running 10 tests with 1 timings for 1 calls of 'Call_Test4'
Starttime 16.03.2010 18:25:27
01. Short 0,41069 Long 0,41069 Average 0,41069
02. Short 0,44354 Long 0,44354 Average 0,44354
03. Short 0,43493 Long 0,43493 Average 0,43493
04. Short 0,43833 Long 0,43833 Average 0,43833
05. Short 0,43535 Long 0,43535 Average 0,43535
06. Short 0,42822 Long 0,42822 Average 0,42822
07. Short 0,44276 Long 0,44276 Average 0,44276
08. Short 0,44116 Long 0,44116 Average 0,44116
09. Short 0,43947 Long 0,43947 Average 0,43947
10. Short 0,43558 Long 0,43558 Average 0,43558
Result:
00. Short 0,43558 Long 0,43558 Average 0,43500
Endtime 16.03.2010 18:25:32
Die Ergebnisse sind richtig, die Umsetzung ist "quick and dirty" ohne
Fehlerabfrage (d.h. Test4 würde damit noch einen Tick länger
brauchen), hast Du Dir das anders vorgestellt?
Andreas.
Sub Call_Test3()
Dim Data
Data = Test3(Range("A1:E16500"))
End Sub
Sub Call_Test4()
Dim Data
Data = Test4(Range("A1:E16500"))
End Sub
Function Test4(Bereich) As Variant
Dim AA, BA, Res
Dim Key As String
Dim Dict As Collection, Dict2 As Collection
Dim I As Long, J As Long, K As Long, Dummy As Long
Set Dict = New Collection
Set Dict2 = New Collection
AA = Bereich
ReDim BA(1 To UBound(AA), 1 To 3)
On Error Resume Next
For I = 1 To UBound(AA)
Key = AA(I, 1) & AA(I, 2)
J = Dict.Item(Key)
If Err Then
Err.Clear
K = K + 1
BA(K, 1) = AA(I, 1)
BA(K, 2) = AA(I, 2)
Dict.Add K, Key
Key = AA(I, 1) & AA(I, 2) & AA(I, 5)
Dict2.Add K, Key
BA(K, 3) = 1
Else
Key = AA(I, 1) & AA(I, 2) & AA(I, 5)
Dummy = Dict2.Item(Key)
If Err Then
Err.Clear
Dict2.Add J, Key
BA(J, 3) = BA(J, 3) + 1
End If
End If
Next
ReDim Res(1 To K, 1 To 3)
For I = 1 To K
Res(I, 1) = BA(I, 1)
Res(I, 2) = BA(I, 2)
Res(I, 3) = BA(I, 3)
Next
Test4 = Res
End Function
Peter Schleif
>
> warum verwendest du hier das Dictionary-Objekt?
> Nicht nur die Objekterstellung dauert, auch der Zugriff auf die
> einzelnen Elemente ist recht langsam.
Der Vorteil eines Dictionary beim Zählen von Häufigkeiten liegt IMHO in
der kompakten Schreibweise:
dict(key) = dict(key) + 1 'klappt auch wenn key noch nicht exists
Mit einer Collection:
On Error Resume Next
coll.Add 0, key
coll(key) = coll(key) + 1
On Error GoTo 0
Wenn man CreateObject("Scripting.Dictionary") sparsam einsetzt, spielen
die Laufzeit-Differenzen kaum eine Rolle.
Peter
Michael Schwimmer
On Tue, 16 Mar 2010 18:32:57 +0100, Andreas Killer wrote:
> Hmm, coole Idee, kann ich aber nicht best?tigen:
> Fehlerabfrage (d.h. Test4 w?rde damit noch einen Tick l?nger
> brauchen), hast Du Dir das anders vorgestellt?
Ob man in deinem Fall die Unterschiede in der Laufzeit bemerkt, wei?
ich nicht. Ich hatte anders getestet:
Sub TestDict()
Dim objDict As Object
Dim dteBegin As Date
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
Set objDict = CreateObject("Scripting.Dictionary")
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Add strKey, 1
Next
Next
Next
Next
strAdd = Format(Now - dteBegin, "nn:ss")
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
If Not objDict.Exists(strKey) Then e = e
Next
Next
Next
Next
strExist = Format(Now - dteBegin, "nn:ss")
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Remove strKey
Next
Next
Next
Next
strRemove = Format(Now - dteBegin, "nn:ss")
Debug.Print "objDict.Add : " & strAdd & vbCrLf & _
"objDict.Exists : " & strExist & vbCrLf & _
"objDict.Remove : " & strRemove
End Sub
Sub TestCol()
Dim objCol As Collection
Dim dteBegin As Date
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim varDummy As Variant
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
On Error Resume Next
Set objCol = New Collection
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Add 1, strKey
Next
Next
Next
Next
strAdd = Format(Now - dteBegin, "nn:ss")
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
Err.Clear
varDummy = objCol(strKey)
If Err.Number <> 0 Then e = e
Next
Next
Next
Next
strExist = Format(Now - dteBegin, "nn:ss")
dteBegin = Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Remove strKey
Next
Next
Next
Next
strRemove = Format(Now - dteBegin, "nn:ss")
Debug.Print "objCol.Add : " & strAdd & vbCrLf & _
"objCol.Exists : " & strExist & vbCrLf & _
"objCol.Remove : " & strRemove
End Sub
M?glicherweise passt meine Messmethode ja auch nicht zum Vergleich der
beiden Objekte, oder ich mache einen anderen Denkfehler dabei. Messen
kommt ja bekannterma?en von Mist. Kannst es ja mal bei dir testen.
Besonders negativ f?llt mir das Dictionary-Objekt auf, wenn ich bei
der Remove-Methode eine andere Reihenfolge ansetze:
dteBegin = Now
For a = 90 To 65 Step -1
For b = 90 To 65 Step -1
For c = 90 To 65 Step -1
For d = 90 To 65 Step -1
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Remove strKey
Next
Next
Next
Next
strRemove = Format(Now - dteBegin, "nn:ss")
Ps. ich wei? nicht, ob ich die Einstellungen von 40tude nach dem
letzten Update versaut habe, meine Antworten erscheinen jedenfalls bei
mir nicht im gleichen Thread.
Viele Gr??e
Michael
Alexander Wolff
Ä Ö Ü ä ö ü ß
Michael Schwimmer
On Tue, 16 Mar 2010 19:29:12 +0100, Peter Schleif wrote:
> Michael Schwimmer schrieb am 16.Mrz.2010 18:07 Uhr:
> Der Vorteil eines Dictionary beim Z?hlen von H?ufigkeiten liegt IMHO in
> der kompakten Schreibweise:
> dict(key) = dict(key) + 1 'klappt auch wenn key noch nicht exists
das Dictionary-Objekt ist nat?rlich wesentlich komfortabler und hat
auch noch den Vorteil, dass man die Elemente ?ndern kann, ohne zu
l?schen und neu einzuf?gen. Au?erdem kann man auch noch den Key
auslesen.
> Wenn man CreateObject("Scripting.Dictionary") sparsam einsetzt, spielen
> die Laufzeit-Differenzen kaum eine Rolle.
ACK
Man setzt aber wie beim FileSystemObject ein fremdes Objekt ein und
macht sich somit abh?ngig davon. Probleme damit d?rfte es bei den
heutigen Systemen aber sicherlich nicht mehr geben.
Viele Gr??e
Michael
Andreas Killer
wrote:
> M?glicherweise passt meine Messmethode ja auch nicht zum Vergleich der
> beiden Objekte, oder ich mache einen anderen Denkfehler dabei. Messen
> kommt ja bekannterma?en von Mist. Kannst es ja mal bei dir testen.
Das ist interessant, konnte ich sogar nachvollziehen.
Nachdem sich der Wirbelwind von tausenden ? in meinem Kopf gelegt
hatte, habe ich erstmal offensichtliche Unterschiede zu Test4 gesucht
und dann einfach mal
if Err Then
zu
if Err.Number <> 0 then
geändert. Und siehe da schon war sie etwas schneller, aber auch nur
0,37 Sekunden (vorher 0,43 Sekunden).
Blieb also nur die zu vergleichende Datenmenge, in Test4 nimmt jede
Collection max. 16500 Daten auf/vergleicht sie, Du arbeitest aber mit
viel mehr Daten.
Und dann habe ich in Deine Routinen mal statt "Now" und "Date" einfach
"Timer" und "Double" genommen und kurzerhand die "for d ="
auskommentiert um auf (90-65)^3 = 15625 Elemente zu kommen und siehe
da:
objDict.Add : 0,10959375
objDict.Exists : 0,10996875
objDict.Remove : 0,09371875
objCol.Add : 0,21871875
objCol.Exists : 0,09346875
objCol.Remove : 0,09421875
Schon ist das Dictionary insgesamt schneller. Ich häng die
modifizierten Routinen mal unten dran.
> Ps. ich wei? nicht, ob ich die Einstellungen von 40tude nach dem
> letzten Update versaut habe, meine Antworten erscheinen jedenfalls bei
> mir nicht im gleichen Thread.
Jipp, da ist was krumm, die Umlaute sind für'n Popo.
Andreas.
Sub TestDict()
Dim objDict As Object
Dim dteBegin As Double 'Date
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
Set objDict = CreateObject("Scripting.Dictionary")
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Add strKey, 1
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strAdd = Format(Timer - dteBegin, "0.00000000")
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
If Not objDict.Exists(strKey) Then e = e
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strExist = Format(Timer - dteBegin, "0.00000000")
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Remove strKey
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strRemove = Format(Timer - dteBegin, "0.00000000")
Debug.Print "objDict.Add : " & strAdd & vbCrLf & "objDict" & _
".Exists : " & strExist & vbCrLf & "objDict.Remove : " & _
strRemove
End Sub
Sub TestCol()
Dim objCol As Collection
Dim dteBegin As Double 'Date
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim varDummy As Variant
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
On Error Resume Next
Set objCol = New Collection
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Add 1, strKey
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strAdd = Format(Timer - dteBegin, "0.00000000")
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
Err.Clear
varDummy = objCol(strKey)
If Err.Number <> 0 Then e = e
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strExist = Format(Timer - dteBegin, "0.00000000")
dteBegin = Timer 'Now
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
'For d = 65 To 90
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Remove strKey
'Next
Next
Next
Next
'Format(Now - dteBegin, "nn:ss")
strRemove = Format(Timer - dteBegin, "0.00000000")
Debug.Print "objCol.Add : " & strAdd & vbCrLf & "objCol" & _
".Exists : " & strExist & vbCrLf & "objCol.Remove : " & strRemove
End Sub
Michael Schwimmer
On Wed, 17 Mar 2010 02:07:19 -0700 (PDT), Andreas Killer wrote:
> Blieb also nur die zu vergleichende Datenmenge, in Test4 nimmt jede
> Collection max. 16500 Daten auf/vergleicht sie, Du arbeitest aber mit
> viel mehr Daten.
>
> Und dann habe ich in Deine Routinen mal statt "Now" und "Date" einfach
> "Timer" und "Double" genommen und kurzerhand die "for d ="
> auskommentiert um auf (90-65)^3 = 15625 Elemente zu kommen und siehe
> da:
> objDict.Add : 0,10959375
> objDict.Exists : 0,10996875
> objDict.Remove : 0,09371875
> objCol.Add : 0,21871875
> objCol.Exists : 0,09346875
> objCol.Remove : 0,09421875
Hier meine gemessenen Zeiten.
objDict.Add : 0,10937500
objDict.Exists : 0,07812500
objDict.Remove : 0,09375000
objCol.Add : 0,18750000
objCol.Exists : 0,07812500
objCol.Remove : 0,07812500
Beim Entfernen von Elementen in anderer Reihenfolge
mit sonst gleichem Code:
For a = 90 To 65 Step -1
For b = 90 To 65 Step -1
For c = 90 To 65 Step -1
objDict.Add : 0,09375000
objDict.Exists : 0,09375000
objDict.Remove : 8,03125000
objCol.Add : 0,17187500
objCol.Exists : 0,07812500
objCol.Remove : 0,07812500
Bei solch kurzen Laufzeiten ist aber ein vern�nftiger Vergleich kaum
noch m�glich, deshalb habe ich ja auch mit mehr Elementen gearbeitet.
Selbst mit GetTickCount und QueryPerformanceTimer kannst du IMO keine
Vern�nftigen Schlussfolgerungen ziehen, bei solch kurzen Laufzeiten
spielen noch andere Sachen eine Rolle, denke nur mal, wie lange beim
Multitasking eine Zeitscheibe sein kann.
Du siehst ja selbst, dass bereits das Verwenden von Timer gegen�ber
Now einen Geschwindigkeitsunterschied bringt, obwohl sie nur je 6 mal
benutzt werden.
Bei wenigen Elementen ist IMO der Verwaltungsaufwand f�r das
Dictionary-Objekt nicht sehr hoch und der Unterschied gegen�ber einer
Collection verwischt sich. Bei vielen Elementen wird der Zeitaufwand
zum Verwalten aber immer h�her und die Unterschiede werden deutlich
sichtbar. Irgend woher muss ja der Komfort kommen.
Mit einem QueryPerformanceCounter gemessen:
Elemente : 17576
objDict.Add : 0,150172996847365
objDict.Exists : 0,108397296304419
objDict.Remove : 0,159143131319763
objCol.Add : 0,220426059736643
objCol.Exists : 0,142565046674927
objCol.Remove : 0,112126541222418
Elemente : 105456
objDict.Add : 2,40500342920678
objDict.Exists : 1,91507104953283
objDict.Remove : 2,20210753042635
objCol.Add : 1,613119265158
objCol.Exists : 0,923591406170337
objCol.Remove : 0,729649997415873
Elemente : 281216
objDict.Add : 13,5046540831307
objDict.Exists : 12,5530498988
objDict.Remove : 12,9670938624881
objCol.Add : 4,74534864067919
objCol.Exists : 2,5485415045767
objCol.Remove : 1,99320081183502
Elemente : 456976
objDict.Add : 20,2496753078953
objDict.Exists : 18,918632954747
objDict.Remove : 20,0249945174596
objCol.Add : 6,39869508554858
objCol.Exists : 3,319228840537
objCol.Remove : 2,52449934279357
Nachfolgend der Code, mit dem gemessen wurde:
Option Explicit
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Declare Function QueryPerformanceCounter _
Lib "kernel32" ( _
lpPerformanceCount As LARGE_INTEGER _
) As Long
Private Declare Function QueryPerformanceFrequency _
Lib "kernel32" ( _
lpFrequency As LARGE_INTEGER _
) As Long
Private Declare Sub CopyMemory _
Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Function TestDict()
Dim objDict As Object
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim lngDMax As Long
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
Dim udtFrequence As LARGE_INTEGER
Dim udtBegin As LARGE_INTEGER
Dim udtEnd As LARGE_INTEGER
Dim curBegin As Currency
Dim curEnd As Currency
Dim curFrequence As Currency
Dim strElements As String
lngDMax = 90
Set objDict = CreateObject("Scripting.Dictionary")
QueryPerformanceFrequency udtFrequence
CopyMemory curFrequence, udtFrequence, 8&
curFrequence = curFrequence * 10000
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Add strKey, "1"
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strAdd = CStr((curEnd - curBegin) / curFrequence)
strElements = "Elemente : " & objDict.Count
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
If Not objDict.Exists(strKey) Then e = e
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strExist = CStr((curEnd - curBegin) / curFrequence)
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objDict.Remove strKey
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strRemove = CStr((curEnd - curBegin) / curFrequence)
Debug.Print strElements & vbCrLf & _
"objDict.Add : " & strAdd & vbCrLf & _
"objDict.Exists : " & strExist & vbCrLf & _
"objDict.Remove : " & strRemove
End Function
Function TestCol()
Dim objCol As Collection
Dim a As Long
Dim b As Long
Dim c As Long
Dim d As Long
Dim e As Long
Dim lngDMax As Long
Dim varDummy As Variant
Dim strKey As String * 4
Dim strAdd As String
Dim strExist As String
Dim strRemove As String
Dim udtFrequence As LARGE_INTEGER
Dim udtBegin As LARGE_INTEGER
Dim udtEnd As LARGE_INTEGER
Dim curBegin As Currency
Dim curEnd As Currency
Dim curFrequence As Currency
Dim strElements As String
On Error Resume Next
lngDMax = 90
Set objCol = New Collection
QueryPerformanceFrequency udtFrequence
CopyMemory curFrequence, udtFrequence, 8&
curFrequence = curFrequence * 10000
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Add 1, strKey
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strAdd = CStr((curEnd - curBegin) / curFrequence)
strElements = "Elemente : " & objCol.Count
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
Err.Clear
varDummy = objCol(strKey & "a")
If Err.Number <> 0 Then e = e
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strExist = CStr((curEnd - curBegin) / curFrequence)
QueryPerformanceCounter udtBegin
For a = 65 To 90
For b = 65 To 90
For c = 65 To 90
For d = 65 To lngDMax
Mid(strKey, 1, 1) = Chr(a)
Mid(strKey, 2, 1) = Chr(b)
Mid(strKey, 3, 1) = Chr(c)
Mid(strKey, 4, 1) = Chr(d)
objCol.Remove strKey
Next
Next
Next
Next
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
strRemove = CStr((curEnd - curBegin) / curFrequence)
Debug.Print strElements & vbCrLf & _
"objCol.Add : " & strAdd & vbCrLf & _
"objCol.Exists : " & strExist & vbCrLf & _
"objCol.Remove : " & strRemove
End Function
>> Ps. ich wei? nicht, ob ich die Einstellungen von 40tude nach dem
>> letzten Update versaut habe, meine Antworten erscheinen jedenfalls bei
>> mir nicht im gleichen Thread.
> Jipp, da ist was krumm, die Umlaute sind f�r'n Popo.
Ich hoffe, jezt das Problem mit den Umlauten gefixt zu haben, in der
Test-NG mit einem neuen Posting ging es jedenfalls. �������
Viele Gr��e
Michael
Peter Schleif
>
> Ich hoffe, jezt das Problem mit den Umlauten gefixt zu haben, in der
Zumindest ist das Charset jetzt nicht mehr US-ASCII, sondern ISO-8859-1.
Bei mir sind die Umlaute o.k. Aber Google-Groups liefert in UTF-8 aus
und hat manchmal Probleme ISO-8859-Postings zu konvertieren. Dann kommt
es zu Löchern:
http://groups.google.de/group/microsoft.public.de.excel/msg/3a49ccd3ce0e46a3
Das ist die Schuld von Google-Groups und im Prinzip nicht weiter
wichtig, aber kaum ein News-Server archiviert so lange wie Google, darum
finde ich es zum Nachschlagen alter Postings recht nützlich. Wenn die
dann verstümmelt sind, ist das schade.
Spricht bei Dir was gegen UTF-8?
40tude kann es doch - oder?
Peter
Michael Schwimmer
On Wed, 17 Mar 2010 13:52:59 +0100, Peter Schleif wrote:
>> Ich hoffe, jezt das Problem mit den Umlauten gefixt zu haben, in der
>> Test-NG mit einem neuen Posting ging es jedenfalls. ÜÄÖüäöß
> Spricht bei Dir was gegen UTF-8?
nein, spricht nichts dagegen.
> 40tude kann es doch - oder?
Ja, ich hatte aber noch in der Liste, aus der die für das Posting
geeigneten Zeichensätze ausgewählt werden, Iso 8859-1 und US-Ascii
stehen. Die habe ich jetzt mal entfernt und nur noch UTF-8
dringelassen. Mal sehen, ob jetzt alles funzt.
Vielen Dank für den Hinweis.
Viele Grüße
Michael
Peter Schleif
>
> Mal sehen, ob jetzt alles funzt.
Sieht gut aus. Im Header steht als Charset UTF-8 und auf Google-Groups
sind die Umlaute auch zu sehen.
http://groups.google.de/group/microsoft.public.de.excel/msg/0bea28f373ade1a8
Peter
Bernd P
Sub Count()
Dim obj1 As Object, obj2 As Object
Dim vR As Variant, v As Variant, v2 As Variant
Dim i As Long
Dim s As String, sC As String
Range("F1:G65536").ClearContents
sC = "|"
Set obj1 = CreateObject("Scripting.Dictionary")
Set obj2 = CreateObject("Scripting.Dictionary")
i = 1
Do While Not IsEmpty(Cells(i, 1))
obj1.Item(Cells(i, 1) & sC & Cells(i, 2) & sC & Cells(i, 5)) = 1
i = i + 1
Loop
For Each v In obj1.keys
v2 = Split(v, sC)
s = v2(0) & " " & v2(1)
obj2.Item(s) = obj2.Item(s) + 1
Next v
i = UBound(obj2.keys)
Range(Cells(1, 6), Cells(i + 1, 7)).FormulaArray =
Application.WorksheetFunction.Transpose(Array(obj2.keys, obj2.items))
Set obj1 = Nothing
Set obj2 = Nothing
End Sub
Viele Grüße,
Bernd
Andreas Killer
> Range(Cells(1, 6), Cells(i + 1, 7)).FormulaArray =
> Application.WorksheetFunction.Transpose(Array(obj2.keys, obj2.items))
Diese Zeile erzeugt einen RTE 13 "Typen unverträglich".
Wenn ich das FormulaArray mal weg mache, dann steht in Spalte F das
Datum und das erste Element zusammen, naja, Schönheitsfehler, die
Ergebnisse sind richtig.
Wenn ich das mit Peter's Testdaten laufen lasse braucht das ganze im
Schnitt 1,35 Sekunden. Nochmal zur Erinnerung Test4 läuft 0,37
Sekunden.
Andreas.
Function Test4(Bereich) As Variant
Dim AA, BA, Res
Dim Key As String
Dim Dict As Collection, Dict2 As Collection
Dim i As Long, J As Long, K As Long, Dummy As Long
Set Dict = New Collection
Set Dict2 = New Collection
AA = Bereich
ReDim BA(1 To UBound(AA), 1 To 3)
On Error Resume Next
For i = 1 To UBound(AA)
Key = AA(i, 1) & AA(i, 2)
J = Dict.Item(Key)
If Err.Number <> 0 Then
Err.Clear
K = K + 1
BA(K, 1) = AA(i, 1)
BA(K, 2) = AA(i, 2)
Dict.Add K, Key
Key = AA(i, 1) & AA(i, 2) & AA(i, 5)
Dict2.Add K, Key
BA(K, 3) = 1
Else
Key = AA(i, 1) & AA(i, 2) & AA(i, 5)
Dummy = Dict2.Item(Key)
If Err.Number <> 0 Then
Err.Clear
Dict2.Add J, Key
BA(J, 3) = BA(J, 3) + 1
End If
End If
Next
ReDim Res(1 To K, 1 To 3)
For i = 1 To K
Res(i, 1) = BA(i, 1)
Res(i, 2) = BA(i, 2)
Res(i, 3) = BA(i, 3)
Andreas Killer
> Wenn ich das mit Peter's Testdaten laufen lasse braucht das ganze im
> Schnitt 1,35 Sekunden. Nochmal zur Erinnerung Test4 läuft 0,37
> Sekunden.
Da muss ich gleich mal zurückrudern, ich hab vergessen die Daten in
die Tabelle zu schreiben, sonst wäre es ja nicht vergleichbar:
Sub Call_Test4()
Dim Data
Data = Test4(Range("A1:E16500"))
Range("F1").Resize(UBound(Data), 3) = Data
End Sub
Diese Sub läuft im Schnitt 0,495 Sekunden.
Andreas.
Peter Schürer
> On 18 Mrz., 09:26, Andreas Killer <andreas.kil...@gmx.net> wrote:
>
>> Wenn ich das mit Peter's Testdaten laufen lasse braucht das ganze im
>> Schnitt 1,35 Sekunden. Nochmal zur Erinnerung Test4 läuft 0,37
>> Sekunden.
Es läuft wirklich sehr schnell.
> Da muss ich gleich mal zurückrudern, ich hab vergessen die Daten in
> die Tabelle zu schreiben, sonst wäre es ja nicht vergleichbar:
>
> Sub Call_Test4()
> Dim Data
> Data = Test4(Range("A1:E16500"))
> Range("F1").Resize(UBound(Data), 3) = Data
> End Sub
>
Leider kommen falsche Daten raus.
Deine Function vertauscht Monat mit Tag und macht aus 01.03.10 den
03.01.10, aus 02.03.10 den 03.02.10 usw..
> Diese Sub läuft im Schnitt 0,495 Sekunden.
>
> Andreas.
Gruß
Peter
Peter Schürer
ich finde die ganze Diskussion hier ja sehr toll und anregend.
Ihr redet hier über Zehntel und Hundertstel und optimiert meine
Testdaten und mein Makro schleicht so vor sich hin.
Könnte ich Dir eventuell mal meine Datei schicken?
Das mit den Array's bekomme ich nicht so richtig hin.
Nur mal so zum ansehen ;-) Da könnte ich bestimmt noch viel lernen.
Danke und Gruß
Peter
Andreas Killer
>> Sub Call_Test4()
> Leider kommen falsche Daten raus.
> Deine Function vertauscht Monat mit Tag und macht aus 01.03.10 den
> 03.01.10, aus 02.03.10 den 03.02.10 usw..
Nönö, die Function ist schon in Ordnung, beim Handling über die Sub
gibt es da irgendwo Murks, keine Ahnung.
Liegt wahrscheinlich irgendwo in der Ecke das man mit VBA alles zu
jedem zuweisen kann und die Daten irgendwo vom/in das Range von Excel
umgerechnet werden. Probier mal das:
Sub Test()
Dim S As String, I As Integer
I = 1
S = I * 2
I = S * 2
MsgBox I
End Sub
Also bis "S = I * 2" kann ich das ja noch verstehen das das geht, aber
"I = S * 2" ist eigentlich Schwachsinn und dürfte IMHO gar nicht gehen
und müsste einen RTE erzeugen, aber...
Benutze die Function als Matrixformel, dann kommen da auch die
richtigen Daten raus.
Andreas.
Andreas Killer
> ich finde die ganze Diskussion hier ja sehr toll und anregend.
Jipp, ich auch, hab ich wieder eine Menge gelernt.
> Ihr redet hier über Zehntel und Hundertstel und optimiert meine
> Testdaten und mein Makro schleicht so vor sich hin.
Oft es ist auf den zweiten Blick anders als man vorher gedacht hat,
passiert mir auch. :-)
Ich hatte mal aus sportlichem Interesse sogar einen binären Baum daran
probiert, welche ja irre schnell sind wenn man was sucht, aber auch
hier Pustekuchen, eine "popelige" Collection schlägt einen den
VBA-Baum um Längen.
> Könnte ich Dir eventuell mal meine Datei schicken?
Wenn Du ein Budget hast, gerne. .-)
> Das mit den Array's bekomme ich nicht so richtig hin.
Tja, es ist zwar richtig schnell, aber technisch sehr anspruchsvoll.
Soweit ich aber gelesen hab hast Du auch irgendwelche Formel drin, von
daher kannst Du das mit dem Array vergessen.
Formel und Array zusammen geht zwar unter bestimmten Bedingungen und
hohem Aufwand, aber meistens in die Hose und bringt dann auch keinen
Effekt.
Andreas.
Bernd P
Meine Sub Count läuft unter Excel 2007 etwa 2.1s, Dein Test4 circa
2.7s.
(Meine Testdaten)
Viele Grüße,
Bernd
Peter Schürer
> Peter Sch�rer schrieb:
>
>> K�nnte ich Dir eventuell mal meine Datei schicken?
> Wenn Du ein Budget hast, gerne. .-)
magst Du nicht und die machen auch dick. Deswegen lassen wir das mit
Datei schicken.
>
>> Das mit den Array's bekomme ich nicht so richtig hin.
> Tja, es ist zwar richtig schnell, aber technisch sehr anspruchsvoll.
>
> Soweit ich aber gelesen hab hast Du auch irgendwelche Formel drin, von
> daher kannst Du das mit dem Array vergessen.
Die Formel wird in Spalte O eingef�gt, Zelle kopiert und der Wert
eingef�gt (umst�ndlich), danach n�chste Zeile.
Wenn ich w�ste wie man statt der Formel gleich den Monat aus Spalte A
bekommt, w�rde ich es machen.
>
> Formel und Array zusammen geht zwar unter bestimmten Bedingungen und
> hohem Aufwand, aber meistens in die Hose und bringt dann auch keinen
> Effekt.
>
> Andreas.
Gru�
Peter
Andreas Killer
> Moment, die Formel ist =Text(A???;"MMMM").
> Wenn ich w ste wie man statt der Formel gleich den Monat aus Spalte A
> bekommt, w rde ich es machen.
Na da kann ich doch helfen.
Sub Test()
Dim Datum, Monat
Datum = Now()
Monat = MonthName(Month(Datum))
MsgBox Monat
End Sub
Alles chlor?
Andreas.
Andreas Killer
> Meine Sub Count läuft unter Excel 2007 etwa 2.1s, Dein Test4 circa
> 2.7s.
Hmm, ist XL2007 lahmar...?
> (Meine Testdaten)
Kannst Du die mal (als XL2000-File oder CSV) irgendwo hochladen? Das
interessiert mich ja nun doch. :-))
Andreas.
Michael Schwimmer
On Fri, 19 Mar 2010 01:07:45 -0700 (PDT), Andreas Killer wrote:
>> Meine Sub Count läuft unter Excel 2007 etwa 2.1s, Dein Test4 circa
>> 2.7s.
> Hmm, ist XL2007 lahmar...?
>
>> (Meine Testdaten)
> Kannst Du die mal (als XL2000-File oder CSV) irgendwo hochladen? Das
> interessiert mich ja nun doch. :-))
die Diskussion gefällt mir gut, Optimierung ist ja wirklich ein
interessantes Thema. Ich hätte da auch noch Code zum Testen:
Erzeugen der Daten:
Sub CreateData()
Dim dteAct As Date
Dim i As Long
dteAct = DateSerial(2010, 1, 1)
Randomize Timer
Application.ScreenUpdating = False
For i = 1 To 20000
If (i Mod 20) = 0 Then dteAct = dteAct + 1
Me.Cells(i, 1) = dteAct
Me.Cells(i, 2) = Int(3 * Rnd + 1)
Me.Cells(i, 5) = Int(8 * Rnd + 1)
Next
Application.ScreenUpdating = True
End Sub
Die Auswertung (Ausgabe auf gleichem Blatt ab Spalte G):
Private Type LARGE_INTEGER
LowPart As Long
HighPart As Long
End Type
Private Declare Function QueryPerformanceCounter _
Lib "kernel32" ( _
lpPerformanceCount As LARGE_INTEGER _
) As Long
Private Declare Function QueryPerformanceFrequency _
Lib "kernel32" ( _
lpFrequency As LARGE_INTEGER _
) As Long
Private Declare Sub CopyMemory _
Lib "kernel32.dll" Alias "RtlMoveMemory" ( _
Destination As Any, _
Source As Any, _
ByVal Length As Long)
Sub Test()
Dim varSource As Variant
Dim colSource As New Collection
Dim colDummy As Collection
Dim lngIndex As Long
Dim lngMax As Long
Dim strKey1 As String
Dim strKey2 As String
Dim i As Long
Dim udtFrequence As LARGE_INTEGER
Dim udtBegin As LARGE_INTEGER
Dim udtEnd As LARGE_INTEGER
Dim curBegin As Currency
Dim curEnd As Currency
Dim curFrequence As Currency
On Error Resume Next
QueryPerformanceFrequency udtFrequence
CopyMemory curFrequence, udtFrequence, 8&
curFrequence = curFrequence * 10000
QueryPerformanceCounter udtBegin
' Application.ScreenUpdating = False
With Worksheets("Daten")
varSource = .Range("A1:E20000")
For i = LBound(varSource, 1) To UBound(varSource, 1)
strKey1 = "x" & varSource(i, 1) & varSource(i, 2)
strKey2 = "x" & varSource(i, 5)
Err.Clear
lngIndex = colSource(strKey1)("Index")
If Err.Number Then
lngMax = lngMax + 1
Set colDummy = New Collection
colDummy.Add lngMax, "Index"
colDummy.Add 1, strKey2
colSource.Add colDummy, strKey1
varSource(lngMax, 1) = varSource(i, 1)
varSource(lngMax, 2) = varSource(i, 2)
varSource(lngMax, 3) = 1
Else
Err.Clear
colSource(strKey1).Add 1, strKey2
If Err.Number = 0 Then
varSource(lngIndex, 3) = varSource(lngIndex, 3) + 1
End If
End If
Next
.Range(.Cells(1, 7), .Cells(lngMax, 9)) = varSource
' Application.ScreenUpdating = True
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
Debug.Print CStr((curEnd - curBegin) / curFrequence)
End With
End Sub
Benötigt bei meinem betagten Rechner (AMD 2600+, 2GB Ram), Win XP und
Office 2007 etwa 0,6 Sekunden.
Wenn man bei den zwei Zeilen
strKey1 = "x" & varSource(i, 1) & varSource(i, 2)
strKey2 = "x" & varSource(i, 5)
das "x" & weglässt, kann man noch ein paar hundertstel einsparen ;-)
Deine läuft bei mir genau so lange.
Sub Call_Test4()
Dim Data
Dim udtFrequence As LARGE_INTEGER
Dim udtBegin As LARGE_INTEGER
Dim udtEnd As LARGE_INTEGER
Dim curBegin As Currency
Dim curEnd As Currency
Dim curFrequence As Currency
QueryPerformanceFrequency udtFrequence
CopyMemory curFrequence, udtFrequence, 8&
curFrequence = curFrequence * 10000
QueryPerformanceCounter udtBegin
Data = Test4(Worksheets("Daten").Range("A1:E20000"))
Worksheets("Daten").Range("G1").Resize(UBound(Data), 3) = Data
QueryPerformanceCounter udtEnd
CopyMemory curBegin, udtBegin, 8&
curBegin = curBegin * 10000
CopyMemory curEnd, udtEnd, 8&
curEnd = curEnd * 10000
Debug.Print CStr((curEnd - curBegin) / curFrequence)
End Sub
Sie wird aber sicherlich noch einen Tick schneller, wenn man alles in
einer Prozedur ohne Funktionsaufruf macht.
Viele Grüße
Michael
Andreas Killer
> interessantes Thema. Ich hätte da auch noch Code zum Testen:
Okay, schaun wir mal.
> Erzeugen der Daten:
Gleiche Bedingungen für alle, ich nehm die die Peter mal erzeugt hatte.
> Sub Test()
...
> Dim udtFrequence As LARGE_INTEGER
> Dim udtBegin As LARGE_INTEGER
> Dim udtEnd As LARGE_INTEGER
> Dim curBegin As Currency
> Dim curEnd As Currency
> Dim curFrequence As Currency
Den Counter-Part entferne ich mal, weil ich die Zeiten "extern" messe.
> varSource = .Range("A1:E20000")
Hier reduziere ich das mal auf 16500 mehr Daten hab ich nicht.
> lngIndex = colSource(strKey1)("Index")
>
> If Err.Number Then
>
> lngMax = lngMax + 1
>
> Set colDummy = New Collection
> colDummy.Add lngMax, "Index"
> colDummy.Add 1, strKey2
>
> colSource.Add colDummy, strKey1
Das sieht aber interessant aus, witzige Idee.
> Benötigt bei meinem betagten Rechner (AMD 2600+, 2GB Ram), Win XP und
> Office 2007 etwa 0,6 Sekunden.
...
> Deine läuft bei mir genau so lange.
Stimmt, da läßt sich auch bei mir kaum ein Unterschied messen. Ist
schon irre wie schnell so eine Collection ist... wer hätte das gedacht.
BTW, bei dem Ein-/Auslesen der Daten tritt auch hier das gleiche
"Phenomen" auf das teilweise das Datum Tag/Monat vertauscht ist.
Jedes Datum vom 1. bis zum 12. eines Monats ist okay, alle anderen
sind verdreht. Ich hab mittlerweile eine Abhilfe dafür gefunden, man
muss beim Einlesen mit der Range.Value2 arbeiten, dann geht's.
Interessanter Weise laufen die Routinen dann auch schneller. :-)))
Andreas.
Peter Schleif
>
> Gleiche Bedingungen für alle, ich nehm die die Peter mal erzeugt hatte.
Welche sind das?
Es reicht nicht aus, die 10 Zeilen, die ich gepostet hatte, runter zu
kopieren.
Auch die Formeln von Alexander sind nicht sehr zufällig, weil die
RND-Multiplikatoren zu klein sind. Darum sind auch die Werte in der
Mappe die ich hochgeladen hatte nicht sonderlich aussagekräftig. In
einer Spalte gab es z.B. nur 0 oder 1.
Peter
Andreas Killer
>> Gleiche Bedingungen für alle, ich nehm die die Peter mal erzeugt hatte.
> Welche sind das?
Naja, Du hattest ja mal eine Mappe hochgeladen, die nehme ich halt.
> Auch die Formeln von Alexander sind nicht sehr zufällig, weil die
> RND-Multiplikatoren zu klein sind. Darum sind auch die Werte in der
> Mappe die ich hochgeladen hatte nicht sonderlich aussagekräftig. In
> einer Spalte gab es z.B. nur 0 oder 1.
Mag sein, so spielt halt das Leben, haste einmal was gemacht, dann
hängste dran. :-)))
Bernd hatte ja andere Ergebnisse mit seinen eigenen Daten...,
vielleicht stellt er sie mal zur Verfügung...
Aber ich kann ja mal grad nach Alexanders Formel 20 verschiedene Werte
in Spalte B und E generieren, dann bekomme ich diese Zeiten (Test5 ist
die Routine von Michael Schwimmer).
Naja, dauert ein Augenzwinkern länger. :-))
Wenn Du möchtest lade ich die Mappe auch gerne hoch.
Andreas.
Running 3 tests with 1 timings for 1 calls of 'Call_Test4'
Starttime 19.03.2010 19:04:40
1. Short 0,62747 Long 0,62747 Average 0,62747
2. Short 0,63124 Long 0,63124 Average 0,63124
3. Short 0,62976 Long 0,62976 Average 0,62976
Result:
0. Short 0,62976 Long 0,62976 Average 0,62949
Endtime 19.03.2010 19:04:41
Running 3 tests with 1 timings for 1 calls of 'Call_Test5'
Starttime 19.03.2010 19:04:41
1. Short 0,60168 Long 0,60168 Average 0,60168
2. Short 0,58864 Long 0,58864 Average 0,58864
3. Short 0,60129 Long 0,60129 Average 0,60129
Result:
0. Short 0,60129 Long 0,60129 Average 0,59721
Endtime 19.03.2010 19:04:43
Running 3 tests with 1 timings for 1 calls of 'Call_Count'
Starttime 19.03.2010 19:04:43
1. Short 1,52312 Long 1,52312 Average 1,52312
2. Short 1,55753 Long 1,55753 Average 1,55753
3. Short 1,54839 Long 1,54839 Average 1,54839
Result:
0. Short 1,54839 Long 1,54839 Average 1,54301
Endtime 19.03.2010 19:04:48
Running 3 tests with 1 timings for 1 calls of 'Call_Frequency_Schuerer'
Starttime 19.03.2010 19:04:48
1. Short 1,16828 Long 1,16828 Average 1,16828
2. Short 1,12399 Long 1,12399 Average 1,12399
3. Short 1,12013 Long 1,12013 Average 1,12013
Result:
0. Short 1,12013 Long 1,12013 Average 1,13746
Endtime 19.03.2010 19:04:51
Running 3 tests with 1 timings for 1 calls of 'Call_UngleicheZaehlen'
Starttime 19.03.2010 19:04:51
1. Short 4,64121 Long 4,64121 Average 4,64121
2. Short 4,61844 Long 4,61844 Average 4,61844
3. Short 4,58838 Long 4,58838 Average 4,58838
Result:
0. Short 4,58838 Long 4,58838 Average 4,61601
Endtime 19.03.2010 19:05:05
Peter Schleif
>
> Naja, Du hattest ja mal eine Mappe hochgeladen, die nehme ich halt.
Das dachte ich mir. Die Werte sind IMHO nicht genügend zufällig.
> Wenn Du möchtest lade ich die Mappe auch gerne hoch.
Nicht für mich. Ich habe ohnehin nur wenig Verständnis und noch weniger
Zeit für diese rein theoretische Überlegungen irgendwo 1/10 sec zu
sparen. Interessant ist es natürlich und vielleicht hilft es sogar zu
einem besseren Verständnis von VBA.
Aber der praktische Nutzen geht gegen Null. Wenn etwas spürbar langsam
ist, dann muss man sich natürlich optimieren. Aber ein 1/10 ist nicht
spürbar, sondern nur messbar.
In diesem Sinne, wünsche ich Euch noch viel Spaß. :-)
Peter
Bernd P
Hallo Andreas,
Das war ganz simpel
1. Zufaellig irgendein Tag im Januar 2010.
2. Zufaellig einer der ersten 10 Buchstaben A..J
3. Eine Zufallszahl zwischen 1..10
und dann das Ganze bis 65536 hinunterkopiert.
Sicherlich haengt das Ergebnis von Zahl der unterschiedlichen
Eintraege ab, die ich hier um Einiges eingrenzte.
Viele Gruesse,
Bernd