Makro:IsTime und MakeTime

Aus XIMES

Prüft, ob etwas eine Zeit sein könnte

  Public Function IsTime(was As Variant) As Boolean
   'Prüft, ob etwas eine Zeit ist
   Dim help As Double
       '
       IsTime = True
       '
       If was = "" Then IsTime = False
       If was = " " Then IsTime = False
       If was = "-" Then IsTime = False
       If was = "x" Then IsTime = False
       If was = "." Then IsTime = False
       If Not (IsNumeric(was)) And IsTime Then
           '
           help = MakeTime(was)
           If help >= 0 And help <= 1 Then
               IsTime = True
           Else
               IsTime = False
           End If
       End If
       '
   End Function
   

Formt etwas in Zeit um

  Public Function MakeTime(was As Variant, Optional bStopIfNotTime As Boolean = False) As Double
  'Rechnet aus verschiedenen Formaten in Zeit um.
  'ERWARTET: als Eingabe eine eit als Text oder Zahl.
  'ACHTUNG: Datum und Zeit müssen schon getrennt sein
  'AKZEPTIERT WERTE
  'Wert        Ergebnis
  ' 7          7:00
  ' 7,30       7:30
  ' 700        7:00
  ' 07:00      7:00
  ' 07.00      7:00
  ' 07:00:00   7:00:00
  ' AKZEPTIERT NICHT
  ' 8000       ... wäre 08:00 aber unklar
  Dim htext As String
  Dim BConvert As Boolean
  Dim rest As Double
      '
      BConvert = True
      htext = was  'erzwungene Konvertierung um "." und ähnliches abzufangen
      
      '*** ES IST EIN ZAHL EINGETROFFEN
      If IsNumeric(was) Then
          If (Val(htext * 10 ^ 12) / 10 ^ 12 - was) ^ 2 < 0.0000001 Then
              'Mit Isnumeric würde 14.09 als Numeric erkannt und falsch als 14 weiter gerechnet,
              '= geht auch nicht ganz genau
              'und Val("1,2999") liefert
              If Right(htext, 1) = "-" Then htext = Left(htext, Len(htext) - 1)
              MakeTime = htext

              'um Dienge abzufagen wie 0030 konvertiert in 30
              If MakeTime >= 30 Then
                   rest = MakeTime
                   MakeTime = Int(MakeTime / 100) * 100
                   rest = rest - MakeTime
                   MakeTime = MakeTime / 100 / 24 + rest / 60 / 24
              'für 8,5 etc...
              ElseIf MakeTime > 1 Then
                   rest = MakeTime
                   MakeTime = Int(MakeTime)
                   rest = rest - MakeTime
                   MakeTime = MakeTime / 24 + rest / 60 / 24 * 100
               End If
               
               BConvert = False
          End If
          
      End If
      
      '**** Es beinahltet Sonderzeichen
      If BConvert Then
          htext = Trim(htext)
          If Right(htext, 1) = "-" Then htext = Left(htext, Len(htext) - 1)
          
          htext = Replace(htext, """", "") 'doppelte Hochkomma entfernen
          If Len(htext) = 1 Or Len(htext) = 2 Then
              'Format 5  ... als Stunde interpretiert
              MakeTime = Val(htext) / 24
          ElseIf Len(htext) = 3 Then
              'Format 8:00 oder 8,0
              MakeTime = Val(htext) / 24 / 60
          ElseIf Len(htext) = 4 Or Len(htext) = 5 Then
              'Format 05:23 oder 5.23 oder ...
              If InStr(1, htext, ":") Or InStr(1, htext, ".") Or InStr(1, htext, "_") Then
                   MakeTime = Val(Left(htext, Len(htext) - 3)) / 24 + Val(Right(htext, 2)) / 24 / 60
               Else
                   MakeTime = Val(Left(htext, Len(htext) - 2)) / 24 + Val(Right(htext, 2)) / 24 / 60
               End If
          ElseIf Len(htext) = 7 Then
              'Format 5:23:45 oder 5.23.45 oder ...
              MakeTime = Val(Left(htext, 1)) / 24 + Val(Mid(htext, 3, 2)) / 24 / 60 + Val(Right(htext, 2)) / 24 / 60 / 60
          ElseIf Len(htext) = 8 Then
              'Format 05:23:45 oder 05.23.45 oder ...
              MakeTime = Val(Left(htext, 2)) / 24 + Val(Mid(htext, 4, 2)) / 24 / 60 + Val(Right(htext, 2)) / 24 / 60 / 60
          Else
              Stop 'Format unklar
          End If
      End If
      
      If MakeTime < 0 Or MakeTime > 1 Then
           '*** Eventuell Ausschalten für grob fehlerhafte Daten
           If bStopIfNotTime Then Stop
      End If
      
  End Function