oprunding af et klokkeslæt

Option Explicit
Dim Tid As Date, Colonne As String, Raekke As Integer
Sub CommandButton1_Click()
  Tid = Format(Time, "hh:mm")
  Kvarter
  Colonne = Mid(ActiveCell.Address, 2, 1)
 
  If Colonne = "B" Then
      ActiveCell.Value = Tid
      Raekke = Mid(ActiveCell.Address, 4)
      Cells(Raekke, 5).Activate
      GoTo E
  Else
  End If
 
  If Colonne = "C" Then
      Tid = Format(Time, "hh:mm")
      ActiveCell.Value = Tid
      Raekke = Mid(ActiveCell.Address, 4)
      Cells(Raekke + 1, 1).Activate
      GoTo E
  Else
  End If

  MsgBox "Fejl - Du skal stå i et klokkeslets-felt"
E:

End Sub
Private Sub Kvarter()
    Dim num() As String
    Dim lMin As Integer
    num = Split(Tid, ":")
    Select Case num(1)
        Case Is < 16
            lMin = 15
        Case 16 To 30
            lMin = 30
        Case 31 To 45
            lMin = 0
        Case Else
    End Select
    Tid = Format(num(0) & ":" & lMin, "hh:mm")
End Sub

Option Explicit
Dim Tid As Date, Colonne As String, Raekke As Integer
Sub CommandButton1_Click()
  Tid = Format(Time, "hh:mm")
  Kvarter
  Colonne = Mid(ActiveCell.Address, 2, 1)
 
  If Colonne = "B" Then
      ActiveCell.Value = Tid
      Raekke = Mid(ActiveCell.Address, 4)
      Cells(Raekke, 5).Activate
      GoTo E
  Else
  End If
 
  If Colonne = "C" Then
      Tid = Format(Time, "hh:mm")
      ActiveCell.Value = Tid
      Raekke = Mid(ActiveCell.Address, 4)
      Cells(Raekke + 1, 1).Activate
      GoTo E
  Else
  End If

  MsgBox "Fejl - Du skal stå i et klokkeslets-felt"
E:

End Sub
Private Sub Kvarter()
    Dim num() As String
    Dim lMin As Integer, Ltime As Integer
    num = Split(Tid, ":")
    Ltime = num(0)
    Select Case num(1)
        Case Is < 16
            lMin = 15
        Case 16 To 30
            lMin = 30
        Case 31 To 45
            lMin = 45
        Case Else
            lMin = 0
            If Ltime = 23 Then
                Ltime = 0
            Else
                Ltime = Ltime + 1
            End If
    End Select
    Tid = Format(Ltime & ":" & lMin, "hh:mm")
End Sub

Private Sub CommandButton1_Click()
 
  If ActiveCell.Column = 2 Then 'B
      ActiveCell.Value = Format(Application.WorksheetFunction.Ceiling(Time, 1 / 96), "hh:mm")
      Cells(ActiveCell.Row, 5).Activate
      GoTo E
  Else
  End If
 
  If ActiveCell.Column = 4 Then 'C
      ActiveCell.Value = Format(Application.WorksheetFunction.Ceiling(Time, 1 / 96), "hh:mm")
      Cells(ActiveCell.Row + 1, 1).Activate
      GoTo E
  Else
  End If

  MsgBox "Fejl - Du skal stå i et klokkeslets-felt"
E:

End Sub