Option Explicit
'
'ohne Prüfung auf Vollständigkeit - d.h. team (Spalte N) bereits vorgetragen
'alle Bezüge auf aktuelles Arebitsblatt
'Zeilen, Spalten und Abstände wie Vorlage - alle sichtbar
'
Dim arrTeam() As Variant
Dim arrRate() As Variant
Dim arrRslt() As Variant
'
Sub GameResults()
'pack alles in Arrays
'Spalte Heim / Gast
arrTeam = ActiveSheet.UsedRange.Columns(4).Resize(, 2).Value
'Spalten mit Punkten
arrRate = ActiveSheet.UsedRange.Columns(7).Resize(, 6).Value
'Ergebnisse
arrRslt = Range("N2").CurrentRegion.Value
CountGames
'in Ergebnisse rückschreiben
Range("N2").CurrentRegion.Value = arrRslt
End Sub
'
'die Aufgaben der Reihe nach wie beschrieben
'
Private Sub CountGames()
Dim x As Long, y As Long, z As Long
'Ergebnisse zeilenweise ab 2
For z = 2 To UBound(arrRslt, 1)
'alte Zeilenwerte rücksetzen
For y = 2 To UBound(arrRslt, 2)
arrRslt(z, y) = 0
Next y
'Teamsuche
For x = 3 To UBound(arrTeam, 1)
'Treffer Heim / Gast
If arrTeam(x, 1) = arrRslt(z, 1) Or arrTeam(x, 2) = arrRslt(z, 1) Then
'Nur wenn points
If Val(arrRate(x, 5)) + Val(arrRate(x, 6)) > 0 Then
'game +
arrRslt(z, 2) = arrRslt(z, 2) + 1
'Heim oder Gast
If arrTeam(x, 1) = arrRslt(z, 1) Then
'Heim - Punkte
Select Case arrRate(x, 5)
Case 3
arrRslt(z, 3) = arrRslt(z, 3) + arrRslt(z, 3) + 1
Case 0
arrRslt(z, 4) = arrRslt(z, 4) + arrRslt(z, 4) + 1
Case 1
arrRslt(z, 5) = arrRslt(z, 5) + arrRslt(z, 5) + 1
End Select
'Rest addieren
arrRslt(z, 6) = arrRslt(z, 6) + arrRate(x, 1)
arrRslt(z, 7) = arrRslt(z, 7) + arrRate(x, 2)
arrRslt(z, 8) = arrRslt(z, 8) + arrRate(x, 3)
arrRslt(z, 9) = arrRslt(z, 9) + arrRate(x, 4)
arrRslt(z, 10) = arrRslt(z, 10) + arrRate(x, 5)
Else
'Gast - Punkte
Select Case arrRate(x, 6)
Case 3
arrRslt(z, 3) = arrRslt(z, 3) + arrRslt(z, 3) + 1
Case 0
arrRslt(z, 4) = arrRslt(z, 4) + arrRslt(z, 4) + 1
Case 1
arrRslt(z, 5) = arrRslt(z, 5) + arrRslt(z, 5) + 1
End Select
'Rest addieren
arrRslt(z, 6) = arrRslt(z, 6) + arrRate(x, 2)
arrRslt(z, 7) = arrRslt(z, 7) + arrRate(x, 1)
arrRslt(z, 8) = arrRslt(z, 8) + arrRate(x, 4)
arrRslt(z, 9) = arrRslt(z, 9) + arrRate(x, 3)
arrRslt(z, 10) = arrRslt(z, 10) + arrRate(x, 6)
End If
End If
End If
Next x
Next z
End Sub
|