Office 2016 Uhrzeit ohne ":" VBA

[FJS95]

Hallo,

ich habe da ein kleines Problem mit einem Makro das ich gefunden habe. Es funktioniert super und macht genau das was es soll

Aber ich möcht es auf einem gewissen Beriech (B3:M26) anwenden. Leider reichen meine VBA Kenntnisse nicht so ganz aus um es anzupassen

Vielleich kann mir jemand helfen 

Code: [Auswählen]

Private Sub Worksheet_Change(ByVal Target As Range)
   Dim Eingabe As Variant
 
   On Error GoTo ErrorHandler
   If Not Intersect(Target, Columns(1)) Is Nothing Then
      Application.EnableEvents = False
      With Target
         .Value = CDate(Left(Format(Target, "0000"), 2) & ":" & Right(Target, 2))
         .NumberFormat = "[hh]:mm"
      End With
   End If
ErrorHandler:
   Application.EnableEvents = True
End Sub

[maninweb]

Hallo,

ersetze Columns(1) durch die passende Range ...

Code: Visual Basic

1. Private Sub Worksheet_Change(ByVal Target As Range)
2.    Dim Eingabe As Variant
3.  
4.    On Error GoTo ErrorHandler
5.    If Not Intersect(Target, Range("B3:M26")) Is Nothing Then
6.       Application.EnableEvents = False
7.       With Target
8.          .Value = CDate(Left(Format(Target, "0000"), 2) & ":" & Right(Target, 2))
9.          .NumberFormat = "[hh]:mm"
10.       End With
11.    End If
12. ErrorHandler:
13.    Application.EnableEvents = True
14. End Sub

Gruß

[FJS95]

Hallo,

funktioniert super! Vielen Dank 


Gibt es auch die Möglichkeit mehrere Bereiche zu deffinieren? Also z. B. A1:B4 und D1:E4?

[maninweb]

Hallo,

natürlich geht das...

Code: Visual Basic

1. Private Sub Worksheet_Change(ByVal Target As Range)
2.    Dim Eingabe As Variant
3.  
4.    On Error GoTo ErrorHandler
5.    If Not Intersect(Target, Range("A1:B4")) Is Nothing Or _
6.       Not Intersect(Target, Range("D1:E4")) Is Nothing Then
7.       Application.EnableEvents = False
8.       With Target
9.          .Value = CDate(Left(Format(Target, "0000"), 2) & ":" & Right(Target, 2))
10.          .NumberFormat = "[hh]:mm"
11.       End With
12.    End If
13. ErrorHandler:
14.    Application.EnableEvents = True
15. End Sub

Gruß