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