Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Fußballtabelle aktualisieren

Gruppe

Liste

Problem

Wie kann ich Fußballergebnisse in eine Tabelle übernehmen und diese aktualisieren?

Lösung
Geben Sie den nachfolgenden Code in ein Standardmodul ein und weisen Sie ihn einer Schaltfläche zu.

StandardModule: Modul1

Sub Tabelle()
   Dim iRow As Integer, iRowH As Integer, iRowA As Integer
   iRow = 2
   Do Until IsEmpty(Cells(iRow, 1))
      If Not IsEmpty(Cells(iRow, 10)) And _
         Not IsEmpty(Cells(iRow, 11)) Then
         iRowH = WorksheetFunction.Match(Cells(iRow, 8), Columns(2), 0)
         iRowA = WorksheetFunction.Match(Cells(iRow, 9), Columns(2), 0)
         Cells(iRowH, 3).Value = Cells(iRowH, 3).Value + 1
         Cells(iRowA, 3).Value = Cells(iRowA, 3).Value + 1
         If Cells(iRow, 10).Value > Cells(iRow, 11).Value Then
            Cells(iRowH, 4).Value = Cells(iRowH, 4).Value + 3
         ElseIf Cells(iRow, 10).Value < Cells(iRow, 11).Value Then
            Cells(iRowA, 4).Value = Cells(iRowH, 4).Value + 3
         Else
            Cells(iRowH, 4).Value = Cells(iRowH, 4).Value + 1
            Cells(iRowA, 4).Value = Cells(iRowA, 4).Value + 1
         End If
         Cells(iRowH, 5).Value = Cells(iRowH, 5).Value + Cells(iRow, 10).Value
         Cells(iRowH, 6).Value = Cells(iRowH, 6).Value + Cells(iRow, 11).Value
         Cells(iRowH, 7).Value = Cells(iRowH, 7).Value + Cells(iRow, 10).Value - Cells(iRow, 11).Value
         Cells(iRowA, 5).Value = Cells(iRowA, 5).Value + Cells(iRow, 11).Value
         Cells(iRowA, 6).Value = Cells(iRowA, 6).Value + Cells(iRow, 10).Value
         Cells(iRowA, 7).Value = Cells(iRowA, 7).Value + Cells(iRow, 11).Value - Cells(iRow, 10).Value
      End If
      iRow = iRow + 1
   Loop
   With Range("A1").CurrentRegion.Columns("B:G")
      .Sort _
      key1:=Range("D2"), order1:=xlDescending, _
      key2:=Range("G2"), order2:=xlDescending, _
      key3:=Range("E2"), order3:=xlDescending, _
      header:=True
   End With
End Sub

Sub ResetTab()
   Range("A1").CurrentRegion.Columns("C:G").Value = 0
End Sub