Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
628to632
628to632
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Hajo- Anfrage zu vereinf. Uhrzeiteingabe

Hajo- Anfrage zu vereinf. Uhrzeiteingabe
24.06.2005 11:44:21
Peter
Hallo Hajo,
ich habe auf Deiner Homepage dieses Makro gefunden.
Ist es möglich, die Eingabe so zu verändern, das den Sekunden bei der Eingabe automat. der Wert „0“ zugeordnet wird und nur noch Stunden und Minuten angezeigt werden?
Peter
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'* H. Ziplies                                     *
'* 30.08.03                                       *
'* erstellt von Hajo.Ziplies@web.de               *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
Dim RaBereich As Range, RaZelle As Range
Dim InS As Integer  ' Variable für Stunden
Dim ByM As Byte     ' Variable für Minuten
Dim BySe As Byte    ' Variable für Sekunden
Dim ByZe As Byte    ' Variable für Zehntel
Application.EnableEvents = False
'   Bereich der Wirksamkeit
Set RaBereich = Range("C7:D50,C60,D60")
'    ActiveSheet.Unprotect
For Each RaZelle In Range(Target.Address)
'       überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle <> "" Then
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
RaZelle.Value = RaZelle.Value & "0" ' null ranhängen für zentel
End If
With Cells(RaZelle.Row, RaZelle.Column)
If IsNumeric(RaZelle.Value) Then
Select Case Len(RaZelle.Value)
Case 1
ByZe = RaZelle.Value
BySe = 0
ByM = 0
InS = 0
Case Is < 4
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle.Value, 1, Len(RaZelle.Value) - 1)
ByM = 0
InS = 0
Case Is < 6
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle, Len(RaZelle) - 2, 2)
ByM = Mid(RaZelle, 1, Len(RaZelle) - 3)
InS = 0
Case Is < 8
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle, Len(RaZelle) - 2, 2)
ByM = Mid(RaZelle, Len(RaZelle) - 4, 2)
InS = Mid(RaZelle, 1, Len(RaZelle) - 5)
Case Else
MsgBox "Falsche eingabe"
End Select
.Value = InS & ":" & ByM & ":" & BySe & "." & ByZe
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
.NumberFormat = "[hh]:mm:ss"
Else
.NumberFormat = "[hh]:mm:ss.0"
End If
End If
End With
End If
End If
Next RaZelle
Set RaBereich = Nothing
'    ActiveSheet.Protect
Application.EnableEvents = True
End Sub

1
Beitrag zum Forumthread
Beitrag zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Anfrage zu vereinf. Uhrzeiteingabe
24.06.2005 11:59:37
Hajo_Zi
Hallo Peter
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'* H. Ziplies                                     *
'* 30.08.03; 24.06.05                             *
'* erstellt von Hajo.Ziplies@web.de               *
'* <a href="http://home.media-n.de/ziplies/">http://home.media-n.de/ziplies/</a> *
Dim RaBereich As Range, RaZelle As Range
Dim InS As Integer  ' Variable für Stunden
Dim ByM As Byte     ' Variable für Minuten
Dim BySe As Byte    ' Variable für Sekunden
Dim ByZe As Byte    ' Variable für Zehntel
Application.EnableEvents = False
'   Bereich der Wirksamkeit
Set RaBereich = Range("C7:D50,C60,D60")
'    ActiveSheet.Unprotect
For Each RaZelle In Range(Target.Address)
'       überprüfen ob Zelle im vorgegebenen Bereich
If Not Intersect(RaZelle, RaBereich) Is Nothing Then
If RaZelle <> "" Then
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
RaZelle.Value = RaZelle.Value & "0" ' null ranhängen für zentel
End If
With Cells(RaZelle.Row, RaZelle.Column)
If IsNumeric(RaZelle.Value) Then
Select Case Len(RaZelle.Value)
Case 1
ByZe = RaZelle.Value
BySe = 0
ByM = 0
InS = 0
Case Is < 4
ByZe = Right(RaZelle, 1)
BySe = Mid(RaZelle.Value, 1, Len(RaZelle.Value) - 1)
ByM = 0
InS = 0
Case Is < 6
ByZe = Right(RaZelle, 1)
BySe = 0
ByM = Mid(RaZelle, 1, Len(RaZelle) - 3)
InS = 0
Case Is < 8
ByZe = Right(RaZelle, 1)
BySe = 0
ByM = Mid(RaZelle, Len(RaZelle) - 4, 2)
InS = Mid(RaZelle, 1, Len(RaZelle) - 5)
Case Else
MsgBox "Falsche eingabe"
End Select
.Value = InS & ":" & ByM & ":" & BySe & "." & ByZe
If RaZelle.Address <> "$C$60" And RaZelle.Address <> "$D$60" Then
.NumberFormat = "[hh]:mm:ss"
Else
.NumberFormat = "[hh]:mm:ss.0"
End If
End If
End With
End If
End If
Next RaZelle
Set RaBereich = Nothing
'    ActiveSheet.Protect
Application.EnableEvents = True
End Sub

Bitte keine Mail, Probleme sollten im Forum gelöst werden.
Microsoft MVP für Excel
Das Forum lebt auch von den Rückmeldungen.
Betriebssystem Windows 2000 SP4 und Excel Version 2000 SP3.


Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige