Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Ergebnisse in Fussballtabelle eintragen und diese aktualisieren

Gruppe

Berechnen

Problem

Ergebnisse eines Spieltags sollen in eine auf einem anderen Blatt befindliche Tabelle eingetragen werden, wobei die Tabell neu zu sortieren ist.

Lösung
Den nachstehenden Code in ein Standardmodul eingeben, einer Schaltfläche zuweisen und starten.

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