zählenwenns stößt an seine Grenzen

Hallo!
Ich versuche mich gerade an einem Ratingsystem für Fussballmannschaften. Hierzu habe ich in einer Exceltabelle ca. 300000 historische Spieldaten zur Verfügung.
Folgende (relevanten) Überschriften haben die Spalten:
A: Heimteam
B: Auswärtsteam
C: Anzahl Spiele Heimteam in Datenbank vor aktueller Zeile
D: Anzahl Spiele Auswärtsteam in DAtenbank vor aktueller Zeile
C un D sind die Probleme: Ich möchte für das aktuell betrachtete Spiel (sagen wir in Zeile 100.000) berechnen, das wievielte Spiel es in der Datenbank für dieses Team ist.
Ich benutze dafür bislang die Funktion "Summewenns". Weitere Nebenbedingungen sind noch in der Formel, aber die sind für das Problem nicht relevant.
Meine Formel in Zelle C100.000 lautet also: =zählenwenns(c$1:c99.999;c100.000).
Diese Formel funktioniert auch vom Prinzip her, allerdings muss sie bis zur Zeile 300.000 runtergezogen werden. Dies ist für meinen Rechner (oder für Excel selbst?) zu rechenaufwendig und Excel hängt sich auf.
Nun meine Frage: Gibt es eine Möglichkeit, solche Berechnungen auf eine schnellere Art durchzuführen? Vielleicht via VBA? Falls ja, wie würde man den Code in VBA formulieren?
Vielen Dank und viele Grüße,
Andre

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public Sub Dict_Zaehler() Dim MyDic As Object, mm As Long, arQ, arErg() As Long Dim ss As Long, zz As Long Set MyDic = CreateObject("Scripting.dictionary") mm = Cells(Rows.Count, 1).End(xlUp).Row - 1 arQ = Cells(2, 1).Resize(mm, 2) ReDim arErg(1 To mm, 1 To 2) For ss = 1 To 2 For zz = 1 To mm If MyDic.Exists(arQ(zz, ss)) Then MyDic(arQ(zz, ss)) = MyDic(arQ(zz, ss)) + 1 Else MyDic.Add arQ(zz, ss), 0 End If arErg(zz, ss) = MyDic(arQ(zz, ss)) Next zz MyDic.RemoveAll Next ss Cells(2, 3).Resize(mm, 2) = arErg End Sub

Hallo Erich,
vielen vielen Dank! Das ist perfekt und geht blitzschnell. Und ich schlage mich seit ewigen Zeiten mit den Zählenwenn-Formeln durch... Blöd, wenn man so wenig Ahnung hat ;-)
Du kannst mir bestimmt auch noch bei 2 anderen Dingen helfen:
1.Problem:
A: Heimteam
B: Auswärtsteam
C: Tore Heim
D: Tore Auswärts
E: Spiele Heim
F: Spiele Auswärts
G: Summe Tore Heimteam in Datenbank vor aktueller Zeile
H: Summe Tore Auswärtsteam in Datenbank vor aktueller Zeile
C und D sind quasi das Ergebnis des jeweiligen Spiels und bereits in der Datenbank. E und F wären nach deiner vorgeschlagener Methode ermittelt. Wie würde der Code für G und H lauten?
Problem 2:
A: Heimteam
B: Auswärtsteam
C: Tore Heim
D: Tore Auswärts
E: Spiele Heim
F: Spiele Auswärts
G: Summe Tore Heimteam in den letzten 5 Spielen vor aktueller Zeile
H: Summe Tore Auswärtsteam in den letzten 5 Spielen vor aktueller Zeile
Hier würde ich gern sowohl die Summe über die Tore der Mannschaften in den letzten 5 Heimspielen als auch in den letzten 10 Spielen (Heim und Auswärts) bilden.
Nehmen wir an, Team A hat ein Heimspiel (steht also in Spalte A). Mit dem Code, den du mir geschickt hast, kann ich ermitteln, dass es sich dabei um das x.Heimspiel handelt und den Code etwas abgeändert liefert mir auch die Anzahl der Auswärtsspiele (also wie oft stand das Team A bereits in Spalte B). Die Summe sagt mir dann wie oft stand Team A in Spalte A und B. Nehmen wir an es ist aktuell das 50. Heimspiel und das 100. Spiel insgesamt.
Nun würde ich gern berechnen, wie viele Tore Team A in den Spielen 95-99 und in den Heimspielen 45-49 erzielt hat.
Meinst du, du kannst mir für dieses Problem auch so eine hervorragende Lösung zukommen lassen?
Darüber würde ich mich riesig freuen und ich denke, dass dann auch alle meine Probleme (was Excel angeht ;-)) gelöst sind!
Vielen Dank und viele Grüße,
Andre

Option Explicit Sub Dict_Zaehler2() Dim mDicH As Object, mDicG As Object, mm As Long, arQ, arErg() As Long Dim ss As Long, zz As Long, strH As String, strG As String Set mDicH = CreateObject("Scripting.Dictionary") ' Home Set mDicG = CreateObject("Scripting.Dictionary") ' Gast mm = Cells(Rows.Count, 4).End(xlUp).Row - 1 arQ = Cells(2, 2).Resize(mm, 4) ReDim arErg(1 To mm, 1 To 4) For zz = 1 To mm strH = arQ(zz, 1) & arQ(zz, 3) ' Home If mDicH.Exists(strH) Then mDicH(strH) = mDicH(strH) + 1 arErg(zz, 1) = mDicH(strH) Else mDicH.Add strH, 0 arErg(zz, 1) = 0 End If strG = arQ(zz, 1) & arQ(zz, 4) ' Gast If mDicG.Exists(strG) Then mDicG(strG) = mDicG(strG) + 1 arErg(zz, 3) = mDicG(strG) Else mDicG.Add strG, 0 arErg(zz, 3) = 0 End If If mDicG.Exists(strH) Then arErg(zz, 2) = arErg(zz, 1) + mDicG(strH) + 1 Else arErg(zz, 2) = arErg(zz, 1) End If If mDicH.Exists(strG) Then arErg(zz, 4) = arErg(zz, 3) + mDicH(strG) + 1 Else arErg(zz, 4) = arErg(zz, 3) End If Next zz mDicH.RemoveAll mDicG.RemoveAll Cells(2, 9).Resize(mm, 4) = arErg ' Spalten I:L End Sub

Option Explicit Sub Letzte10() Dim mDicH As Object, mDicG As Object, mm As Long, arQ, arErg() As Long Dim ss As Long, zz As Long, strH As String, strG As String, arZ() As Long Set mDicH = CreateObject("Scripting.Dictionary") ' Home Set mDicG = CreateObject("Scripting.Dictionary") ' Gast mm = Cells(Rows.Count, 4).End(xlUp).Row - 1 arQ = Cells(2, 2).Resize(mm, 6) ' Spalten B:G ReDim arErg(1 To mm, 1 To 4) For zz = 1 To mm strH = arQ(zz, 1) & arQ(zz, 2) & arQ(zz, 3) ' Home If mDicH.Exists(strH) Then arZ = mDicH(strH) arErg(zz, 3) = arZ(0) If arZ(-1)

Beliebteste Forumthreads (12 Monate)

zählenwenns stößt an seine Grenzen

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread