Navigation

Themen

Programm ändern Schritt 5

Ein VBA-Programm ändern: Alter berechnen

Nachdem wir nun die Eingaben plausibilisiert haben, können wir anhand des Geburtsdatums (sofern vorhanden) das Alter errechnen.

Im einfachsten Fall müssen wir lediglich das Jahr ermitteln und vom aktuellen Jahr abziehen. Korrekt ist es jedoch, auch Monate und Tage zu berücksichtigen, um auch das aktuell korrekte Alter zu ermitteln.

Lösung für „den Hausgebrauch“ (simple Lösung)

In diesem Fall wird lediglich das Jahr als Basis des Alters benutzt, auch wenn das bedeutet, das Alter falsch zu berechnen, da der Geburtstag noch nicht erreicht ist. Bevor wir hier nun wieder mit Stringfunktionen versuchen, das Jahr zu extrahieren (das wäre: Mid$(sDate, 7, 4)), benutzen wir hierzu zwei weitere VBA-Funktionen, die uns diese Arbeit abnehmen.

Zunächst müssen wir aus dem String mit dem Geburtsdatum einen „echten“ Datumswert erzeugen.

Dazu stellt uns VBA die Konvertierungsfunktion CDate() zur Verfügung. Dieser Funktion wird als Argument der uns bekannte Datumsstring übergeben und wir erhalten den konvertierten String vom Typ Date zurück.

Beispiel:
    Dim sDatum  As String
    Dim dtDatum As Date
 
    sDatum = "01.01.1970"
    dtDatum = CDate(sDatum)

Nachdem wir das Geburtsdatum als „echtes“ Datum zur Verfügung haben, können wir mit einer der verfügbaren Datumsfunktionen von VBA das Jahr ermitteln. In diesem Fall benötigen wir die Year-Funktion. Dieser Funktion wird ein Datum übergeben und man erhält als Rückgabewert das Jahr.

Jahr = Year(dtDatum)

Nachdem wir das Jahr des Geburtstags ermittelt haben, benötigen wir noch das aktuelle Jahr für den Vergleich. Auch hierzu können wir die Year()-Funktion benutzen, nur müssen wir jetzt das Tagesdatum übergeben.

VBA stellt uns hier die Funktion Date() zur Verfügung, die das aktuelle Datum übergibt. Für unser Beispiel bedeutet das:

  Dim dtDate As Date
  dtDate = CDate(txtGebDatum.Value)
  MsgBox "Sie sind/werden " & Year(Date) - Year(dtDate) & " Jahre alt!

In dieser Hinweisanzeige werden verschiedene Informationen zu einem Text zusammengefasst (=konkateniert), in dem die einzelnen Hinweis“teile“ mit dem &-Zeichen zusammengefügt werden!

Unsere Routine hat sich wie folgt verändert:

' Gültigkeitsüberprüfung des Datums
Private Sub txtGebDatum_AfterUpdate()
 
    Dim sDate   As String
    Dim dtDate  As Date
 
   'Eingabe "trimmen"
    sDate = Trim$(txtGebDatum.Value)
   'Länge 0 prüfen
    If Len(sDate) > 0 Then
       'Länge <> 10 prüfen
        If Len(sDate) <> 10 Then
           'Hinweis anzeigen
            MsgBox "Ungültige Datumseingabe. " & _
              "Bitte das Format TT.MM.JJJJ verwenden!"
           'Eingabefeld leeren
            txtGebDatum.Value = ""
        Else
           'Gültigkeit des Datums überprüfen
            If Not IsDate(sDate) Then
               'Hinweis anzeigen
                MsgBox "Ungültige Datumseingabe. " & _
                  "Bitte das Format TT.MM.JJJJ verwenden!"
               'Eingabefeld leeren
                txtGebDatum.Value = ""
            ' An dieser Stelle wurde ein
            ' neuer Else-Zweig eingefügt!
            Else
                dtDate = CDate(sDate)
                MsgBox "Sind sind/werden " & _
                  Year(Date) - Year(dtDate) & " Jahre alt!"
            End If
        End If
    End If
 
End Sub

Hier wurde jetzt die Deklaration der Variablen dtDate vom Type Date hinzugefügt.
Die Deklaration von Variablen (Dim) erfolgt in der Regel zu Beginn einer jeden Routine.
Weiterhin wurden die Errechnung und die Anzeige des Alters in einem neuen Else-Zweig dort eingefügt, wo die Eingabe bereits entsprechend plausibilisiert wurde.

Der Nachteil dieser Lösung liegt in dem Umstand, dass jedes Mal diese Altersberechnung und –anzeige erfolgt, wenn diese Routine aufgerufen wird. Das ist nicht sehr elegant und sollte daher an anderer Stelle erfolgen. Aus diesem Grund werden wir die Berechnung des Alters in eine eigene Funktion auslagern.

Eine Funktion gibt – im Gegensatz zu einer sog. Sub-Routine – einen Wert zurück. In diesem Fall möchten wir der Funktion den Eingabestring übergeben und das errechnete Alter zurückbekommen.

Derartige Funktionen müssen wir selbst erstellen; daher schreiben wir an eine „freie“ Stelle im Codefenster:

' Neue Funktion Alter
Private Function Alter(ByVal dtGebDat As Date) As Long
 
End Function

Die Funktion Alter erhält als Argument einen String (mit der Datumseingabe) und gibt einen numerischen Wert (hier: Typ Long) zurück.

Da es sich um eine eigenständige Funktion handelt, sollten wir innerhalb der Funktion (selbst nochmals) den Stringwert plausibilisieren, da wir nie davon ausgehen dürfen, dass dies bereits geschehen ist und wir „blind“ darauf vertrauen können.

Demzufolge stellt sich diese (vereinfachte) Altersberechnungsfunktion wie folgt dar:

' Einfache Altersberechnung
Private Function Alter(sDatum As String) As Long
 
  Dim dtDate As Date
  sDatum = Trim$(sDatum)
 
  If Len(sDatum) = 10 Then
    If IsDate(sDatum) Then
      dtDate = CDate(sDatum)
      Alter = Year(Date) - Year(dtDate)
    End If
  End If
 
End Function

Nur wenn alle Plausibilitäten erfolgreich durchlaufen wurden, wird das Alter errechnet und zurückgegeben. In allen anderen Fällen erhält man als Rückgabewert 0, dem Standardwert für den Long-Datentyp.

Da wir jetzt eine eigene Funktion für die Altersberechnung haben, müssen wir den zuvor eingefügten Else-Zweig (s.o.) wieder entfernen.

Diese Lösung hat bekanntermaßen den Nachteil, das Alter nicht unbedingt korrekt zu errechen, da lediglich das Jahr und nicht die Monate und Tage berücksichtigt werden.

Hinweis: Es steht jetzt jedem frei, dies zu ändern und die Funktion entsprechend anzupassen, in dem die Tage und der Monat ermittelt werden, um diese Werte gegen das aktuelle Tagesdatum zu prüfen, um das korrekte Alter zu ermitteln...

Profilösung: Die nachfolgende Lösung ist für fortgeschrittene VBA-Programmierer gedacht und wird daher nicht weiter kommentiert:

' Profilösung
Private Function Alter(ByVal dtGebDat As Date) As Long
 
    Alter = Year(Now) - Year(dtGebDat) + _
      (DateSerial(Year(Now), _
       Month(dtGebDat), _
       Day(dtGebDat)) > Now)
 
End Function

Programm ändern Schritt 4 | Inhalt | Programm ändern Schritt 6