AW: Schneller geht es nicht...
18.05.2005 15:00:14
Luc:-?
Hallo Rolf & Boris,
also ich weiß ja nicht - "schnarchlangsam" scheint mir eher die evaluierte Matrixformel (eMf) zu sein. Nachdem ich herausgefunden hatte, worum es sich bei dieser Formel (aus offensichtlich Boris' Trickkiste - sehr elegant!) handelt, habe ich es mal mit For Each...In...Next und COUNTIF (ZÄHLENWENN) versucht. Egal ob mit 2 oder 20 000 Zeilen, Win98SE oder NT2000p, AMD Athlon oder Intel PIII, die Schleife war unter Office2000 deutlich schneller, wenn auch immer noch recht langsam (10:26 ggüber 27:08 min auf PIII-Plattform hier im Institut - zuhause mit Athlon sicher halbe Zeiten). Wahrscheinlich ist die eMf wegen der Vielzahl der wohl pro Zelle lfd Transformationen/-aktionen hier die langsamere Methode. Die stärkere Integration in das XL-Programmgerüst scheint sich deshalb nicht zeitverkürzend auszuzahlen. Evtl erhält man andere Ergebnisse, wenn sehr viele Artikelnr mehrfach auftreten?!
Übrigens bin ich davon ausgegangen, dass in jeder Zeile (=1 DS i.e.S.) nur eine Artikelnr steht, aber weitere Zeilen an dieser Stelle die gleiche Artikelnr enthalten können. Alle Zeilen mit gleicher Artikelnr bilden dann einen DS i.w.S. (edv-technisch = Datenblock).
Normalerweise sind Schleifen schon recht schnell - es kommt nur darauf an, was sie enthalten und wieviel noch zur Laufzeit kompiliert und transformiert wdn muss. Evtl könnte es noch schneller gehen, wenn sich Gesamt- und rückwärts gerichteter Vgl mit CountIf ersetzen bzw optimieren ließen. Vielleicht versuche/t ich/ihr das mal.
In den folgenden Code habe ich eine Eingabealternative mittels InputBox aufgenommen (wenn A1 in Tabelle2 leer ist):
Sub DSZählen()
Rem Autor Luc:-? -- 20050517
Static mAN As Variant
Dim lngCount As Long, x As Range, z As Date
z = Now()
If IsEmpty(Sheets("Tabelle2").Cells(1, 1).Value) Then
mAN = InputBox("Bitte Anzahl angeben!", "Anzahl gleicher ANr/DS", mAN)
Else: mAN = Sheets("Tabelle2").Cells(1, 1).Value
End If
If mAN = "" Then Exit Sub
Sheets("Tabelle1").Select
For Each x In ActiveSheet.Columns(2).Cells
If x.Row = 1 Or IsEmpty(x.Value) Then GoTo nx
With WorksheetFunction
If .CountIf(Range(Cells(2, 2), x), x.Value) = 1 Then
If .CountIf(Columns(2), x.Value) = mAN Then
lngCount = lngCount + 1
End If
End If
End With
nx: Next x
z = Now() - z
MsgBox lngCount & " (Zählzeit: " & z & ")", vbOKOnly, "DS mit " & mAN & "facher ANr"
End Sub
Die Abarbeitung wird für die gesamte Spalte ab B2 durchgeführt, Leerfelder wdn übergangen. Wenn die Abarbeitung bei einem Lehrfeld beendet wdn soll, muss die Zeile...
If x.Row = 1 Or IsEmpty(x.Value) Then GoTo nx
durch die Zeilen
If x.Row = 1 Then GoTo nx
und
If x.Value = "" Then Exit For
ersetzt wdn.
Auf Grund deiner Erklärung, Boris, habe ich hier noch 2-3 Stunden Test unter möglichst realen Bedingungen aufgewendet (hat mir meinen Tagesplan etwas durcheinander gebracht), komme aber vorerst nur zu dem Ergebnis, dass leider alles inakzeptabel langsam ist.
Viele Grüße
Luc :-?