Microsoft Excel

Excel und VBA: Formeln, Programmierung, Lösungen

Die Excel/VBA-Beispiele

Thema

Fußballergebnisse eingeben und Tabelle sortieren

Gruppe

Change

Problem

Im Bereich B2:E5 werden Spielergebnisse eingegeben. Punkte und Tore werden automatisch errechnet und es wird nach Tabellenplatz sortiert.

Lösung
Geben Sie den nachfolgenden Code in das Klassenmodul der UsereForm ein.

ClassModule: Tabelle1

Private Sub Worksheet_Change(ByVal Target As Range)
   If Intersect(Target, Range("B2:E5")) Is Nothing Then Exit Sub
   On Error GoTo 0
   If Cells(Target.Row, 1).Value = Cells(1, Target.Column).Value Then
      Application.EnableEvents = False
      Beep
      MsgBox "Hier sind keine Eingaben erlaubt!"
      Target.ClearContents
      Application.EnableEvents = True
      Exit Sub
   End If
   If InStr(Target.Value, ":") = False Then
      Application.EnableEvents = False
      Beep
      MsgBox "Ungültige Eingabe!"
      Target.ClearContents
      Application.EnableEvents = True
      Exit Sub
   End If
   Call Sortieren
ERRORHANDLER:
   Application.EnableEvents = True
End Sub

StandardModule: Modul1

Function Points(rng As Range) As Integer
   Dim oCell As Range
   Dim iPoints As Integer, iAct As Integer
   Dim sTxt As String
   For Each oCell In rng.Cells
      If Not IsEmpty(oCell) Then
         sTxt = oCell.Value
         iAct = Left(sTxt, InStr(sTxt, ":") - 1) - _
            Right(sTxt, Len(sTxt) - InStr(sTxt, ":"))
         Select Case iAct
            Case Is > 0
               iPoints = iPoints + 3
            Case Is = 0
               iPoints = iPoints + 1
         End Select
      End If
   Next oCell
   Points = iPoints
End Function

Function Goals(rng As Range) As Integer
   Dim oCell As Range
   Dim iGoals As Integer, iAct As Integer
   Dim sTxt As String
   For Each oCell In rng.Cells
      If Not IsEmpty(oCell) Then
         sTxt = oCell.Value
         iAct = Left(sTxt, InStr(sTxt, ":") - 1) - _
            Right(sTxt, Len(sTxt) - InStr(sTxt, ":"))
         iGoals = iGoals + iAct
      End If
   Next oCell
   Goals = iGoals
End Function

Function GoalsCount(rng As Range) As Integer
   Dim oCell As Range
   Dim iGoals As Integer, iAct As Integer
   Dim sTxt As String
   For Each oCell In rng.Cells
      If Not IsEmpty(oCell) Then
         sTxt = oCell.Value
         iAct = Left(sTxt, InStr(sTxt, ":") - 1)
         iGoals = iGoals + iAct
      End If
   Next oCell
   GoalsCount = iGoals
End Function

Sub Sortieren()
   Range("B1").CurrentRegion.Sort _
      key1:=Range("F2"), order1:=xlDescending, _
      key2:=Range("G2"), order2:=xlDescending, _
      key3:=Range("H2"), order3:=xlDescending
End Sub

Sub Schuetzen()
   ActiveSheet.Protect userinterfaceonly:=True
End Sub