Thema: Ergebnisse in Fussballtabelle eintragen und diese aktualisieren

ClassModule: Tabelle5

StandardModule: Modul1

Sub Tabelle()
    Dim E As Range, T As Range, aCell As Range, bCell As Range
    Dim A As Range
    Dim i%, y%, n%
    With Worksheets("Spieltag")
        y = .Cells(Rows.Count, 1).End(xlUp).Row
        Set E = .Range(Cells(2, 1), Cells(y, 4))
    End With
    With Worksheets("Tabelle")
        y = .Cells(Rows.Count, 1).End(xlUp).Row
        Set T = .Range(.Cells(1, 2), .Cells(y, 2))
        Set A = .Range(.Cells(3, 1), .Cells(y, 16))
    End With
    For i = 1 To E.Rows.Count
        Set aCell = T.Find(E.Cells(i, 1))
        aCell.Offset(0, 1) = aCell.Offset(0, 1) + 1
        Set bCell = T.Find(E.Cells(i, 2))
        bCell.Offset(0, 1) = bCell.Offset(0, 1) + 1
        If E.Cells(i, 3) > E.Cells(i, 4) Then
            aCell.Offset(0, 2) = aCell.Offset(0, 2) + 3
            aCell.Offset(0, 6) = aCell.Offset(0, 6) + 1
            aCell.Offset(0, 9) = aCell.Offset(0, 9) + 1
            bCell.Offset(0, 14) = bCell.Offset(0, 14) + 1
        ElseIf E.Cells(i, 3) < E.Cells(i, 4) Then
            bCell.Offset(0, 2) = bCell.Offset(0, 2) + 3
            bCell.Offset(0, 6) = bCell.Offset(0, 6) + 1
            bCell.Offset(0, 12) = bCell.Offset(0, 12) + 1
            aCell.Offset(0, 11) = aCell.Offset(0, 11) + 1
        Else
            aCell.Offset(0, 2) = aCell.Offset(0, 2) + 1
            bCell.Offset(0, 2) = bCell.Offset(0, 2) + 1
            aCell.Offset(0, 7) = aCell.Offset(0, 7) + 1
            aCell.Offset(0, 10) = aCell.Offset(0, 10) + 1
            bCell.Offset(0, 7) = bCell.Offset(0, 7) + 1
            bCell.Offset(0, 13) = bCell.Offset(0, 13) + 1
        End If
        aCell.Offset(0, 3) = aCell.Offset(0, 3) + E.Cells(i, 3)
        aCell.Offset(0, 4) = aCell.Offset(0, 4) + E.Cells(i, 4)
        bCell.Offset(0, 3) = bCell.Offset(0, 3) + E.Cells(i, 4)
        bCell.Offset(0, 4) = bCell.Offset(0, 4) + E.Cells(i, 3)
    Next i
    A.Sort Key1:=A.Range("D1"), Order1:=xlDescending, Key2:= _
        A.Range("G1"), Order2:=xlDescending, Key3:=A.Range("E1"), Order3 _
        :=xlDescending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom
    Worksheets("Tabelle").Select
End Sub

Beiträge aus dem Excel-Forum zu den Themen Allgemein und Berechnen