Thema: Fußballtabelle aktualisieren

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

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