Zählenwenn in mehreren Ranges Highspeed

Function ZÄHLE(Wert As String, ParamArray Rng() As Variant) As Integer Dim Bereich As Variant Dim Zelle As Range For Each Bereich In Rng For Each Zelle In Bereich If Zelle.Value = Wert Then ZÄHLE = ZÄHLE + 1 End If Next Zelle Next Bereich End Function

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Function ZÄHLER(Wert As String, ParamArray Rng() As Variant) As Integer Dim Bereich As Variant For Each Bereich In Rng ZÄHLER = ZÄHLER + Application.WorksheetFunction.CountIf(Bereich, Wert) Next Bereich End Function

Hallo,
weil die Originalfunktion in C++ geschrieben ist. Das ist um einiges schneller als VBA, da in C die Speicherverwaltung effizienter ist. Dafür ist die Sprache aber wesentlich weniger tolerant gegenüber unsauberer Programmierung.
Du machst den Fehler die Zelle in den Bereichen anzusprechen. Schau dir mal an, wie viele Eigenschaften eine Zelle hat. Alle diese Eigenschaften werden, wenn du die Zelle ansprichst, in den Arbeitsspeicher geladen. Also jedes Mal ein paar 1.000 Byte.
Da dich aber nur die Value-Eigenschaft interessiert ist es besser diese erst in ein Array zu schreiben und diese Array abzuarbeiten. So ein einzelner Eintrag im Array hat je nach Zellinhalt zwischen 16 und ein paar 100 Bytes. Damit ist das ganze wesentlich schneller. Auf meinem Rechner, bei 20.000 Zellen maximal 0,01 Sekunde.
Beispiel:

Public Function ZÄHLE_SCHNELL(Wert As String, ParamArray Rng() As Variant) As Double
    Dim Bereich As Variant
    Dim Werte_Array As Variant, Einzelwert As Variant

    For Each Bereich In Rng
        Werte_Array = Bereich.Value2
        For Each Einzelwert In Werte_Array
            If Einzelwert = Wert Then ZÄHLE_SCHNELL = ZÄHLE_SCHNELL + 1
        Next Einzelwert
    Next Bereich

End Function

Gruß
Nepumuk

Hallo,
ich habe zwar nicht mit String sondern mit Zahlen (Double) getestet.
Neue Datei alle Zellen auf Standard.
Bei mir kommt raus, dass Value2 doppelt so schnell.
Bei 65536 Zeilen (xl2007 Kompatibilitätsmodus)
Value2 = 0,0625 Sekunden
Value = 0,125 Sekunden
kommt als Code in Modul1

Option Explicit 
 
Sub Tabelle_Mit_Daten_Fuehr_Test_fuellen() 
 Columns("A:E").Formula = "=ROW()" 'alle Zellen mit einer Zahl füllen 
End Sub 
 
Sub Test1_Value() 
Dim sTime As Single 
Dim A As Long, B As Long, Erg As Long 
Dim meAr As Variant 
Dim SuchWert As Double 
 
sTime = Timer 
 
    SuchWert = 10 
    meAr = Range("A:E").Value 
     
    For A = 1 To Ubound(meAr) 
     For B = 1 To Ubound(meAr, 2) 
      If meAr(A, B) = SuchWert Then Erg = Erg + 1 
     Next B 
    Next A 
 
Debug.Print Erg, Timer - sTime 
 
End Sub 
 
Sub Test2_Value2() 
Dim sTime As Single 
Dim A As Long, B As Long 
Dim meAr As Variant, Erg As Long 
Dim SuchWert As Double 
 
sTime = Timer 
 
    SuchWert = 10 
    meAr = Range("A:E").Value2 
     
    For A = 1 To Ubound(meAr) 
     For B = 1 To Ubound(meAr, 2) 
      If meAr(A, B) = SuchWert Then Erg = Erg + 1 
     Next B 
    Next A 
 
Debug.Print Erg, Timer - sTime 
 
End Sub

Gruß Tino

Beliebteste Forumthreads (12 Monate)

Zählenwenn in mehreren Ranges Highspeed

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zählenwenn in mehreren Ranges Highspeed

14 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

14
Beiträge zum Forumthread

Beiträge zu diesem Forumthread