VBA-Programmierung in Microsoft Excel

Tutorial: Excel-Beispiele

Ergebnisse in Fussballtabelle eintragen und diese aktualisieren

Gruppe

Allgemein

Bereich

Berechnen

Thema

Ergebnisse in Fussballtabelle eintragen und diese aktualisieren

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

    


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