AW: uhrzeit und datum auf einem blatt ohne punkte erfa
06.12.2007 14:17:00
Michael
grüß dich Hajo
du hast je für beide fälle bereits zwei codes in deinen beispielmappen
für datum:
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("B3:C20,D3:D7")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
' ab Vesion XP braucht der Schutz nicht aufgehoben werden
' Formatierung bei Schutz kann über Dialog Schutz eingestellt werden
' ActiveSheet.Unprotect ("Passwort")
For Each RaZelle In Range(Target.Address)
If Not Intersect(RaZelle, RaBereich) Is Nothing And _
(Len(RaZelle.Value2) = 6 Or Len(RaZelle.Value2) = 5) And IsNumeric(RaZelle.Value2) Then
Application.EnableEvents = False
If Len(RaZelle.Value2) = 6 Then
RaZelle.Value = CDate(Mid(RaZelle.Value2, 1, 2) & "." & Mid(RaZelle.Value2, 3, 2) & "." _
& Mid(RaZelle.Value2, 5, 2))
Else
RaZelle.Value = CDate(Mid(RaZelle.Value2, 1, 1) & "." & Mid(RaZelle.Value2, 2, 2) & "." _
& Mid(RaZelle.Value2, 4, 2))
End If
RaZelle.NumberFormat = "dd/mm/yy;@"
Application.EnableEvents = True
Else
RaZelle.NumberFormat = "0"
End If
Next RaZelle
Application.EnableEvents = True
' ActiveSheet.protect ("Passwort")
Set RaBereich = Nothing
End Sub
und für die uhrzeit:
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
If Target.Count > 1 Then Exit Sub
Dim RaBereich As Range ' Bereich der Wirksamkeit
Dim RaZelle As Range ' zur Zeit untersuchte Zelle
Dim InS As Integer ' Variable für Stunde
Dim InM As Integer ' Variable für Minute
Dim InSe As Integer ' Variable für Sekunde
Set RaBereich = Range("D4:E10, H4:H10") ' Bereich der Wirksamkeit festlegem
' noch mehr Bereiche
' Set RaBereich = Union(Range("C7:I26"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26") _
)
' ActiveSheet.Unprotect "Password" ' Schutz der Tabelle aufheben
Application.EnableEvents = False ' Reaktion auf Zellveränderung abschalten
For Each RaZelle In Range(Target.Address) ' Schleife falls mehr als eine Zelle mit einmal _
verändert
If Not Intersect(RaZelle, RaBereich) Is Nothing Then ' Zelle ist im Bereich der _
Wirksamkeit
With RaZelle
If .Value "" Then
If IsNumeric(.Value) And InStr(.Value, ":") = 0 And _
InStr(.Value, ",") = 0 Then
If Len(Target.Value) > 4 Then ' es wurden Stunden eingeben
InS = Left(.Value, Len(.Value) - 4)
InM = Mid(.Value, Len(.Value) - 3, 2)
InSe = Right(.Value, 2)
ElseIf Len(Target.Value) > 2 Then ' es wurden keine Stunden _
eingegeben
InS = 0
InM = Left(.Value, Len(.Value) - 2)
InSe = Right(.Value, 2)
Else ' es wurden nur Sekunden _
eingegeben
InS = 0
InM = 0
InSe = .Value
End If
.NumberFormat = "[h]:mm:ss" ' Zellformat setzen
.Value = InS & ":" & InM & ":" & InSe ' Zeit in Zelle schreiben
End If
End If
End With
End If
Next RaZelle
' ActiveSheet.protect "Password" ' Schutz der Tabelle aufheben
Application.EnableEvents = True ' Reaktion auf Zellveränderung einschalten
End Sub
kann man die beiden codes ganz einfach nicht in eine anweisung zusammenfassen?
vielen dank für einen tipp. ansonsten sind die codes ja super.