Hallo Leute,
ich habe zwei "Private Sub Worksheet_Change" die einzeln funktionieren.
Diese möchte ich aber in einer Tabelle benutzen.
Ich habe schon raus bekommen das man den Namen nicht zwei mal verwenden kann/darf, sondern das man diese zu einen "Sub Worksheet_Change" zusammen fassen muss.
Ich habe es schon mal selbst probiert und leider kommt nur Murks raus, mit meinen minimalen Kenntnisen im VBA bekomme ich es nicht hin.
Ich hoffe das mir jemand von euch helfen kann und bedanke mich schon mal für eure Zeit.
Meine Private Sub Worksheet_Change sind wie folgt aufgebaut.
1.Private Sub Worksheet_Change:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim z As Range
Set RaBereich = Range("c4:c37, e13:e37, f13:f37, g13:g37, i13:i37, j13:j37, k13:k37, l13:l37, m13:m37, n13:n37, o13:o37") ' Bereich der Wirksamkeit festlegem
' noch mehr Bereiche
' Set RaBereich = Union(Range("h7:h31"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If RaBereich Is Nothing Then Exit Sub
Application.EnableEvents = False
For Each z In Target
If z.Value = "" Then
z.Value = z.NoteText
'z.Calculate
End If
If z.HasFormula Then
z.NoteText Text:=z.Formula
z.Interior.ColorIndex = xlColorIndexAutomatic 'Font.ColorIndex = 3
Else
z.Interior.ColorIndex = 3 'Font.ColorIndex = xlColorIndexAutomatic
End If
Next z
Application.EnableEvents = True
End Sub
2. Private Sub Worksheet_Change:
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
Set RaBereich = Range("e13:E37, f13:f37, g13:g37, i13:i37, j13:j37, k13:k37, l13:l37, m13:m37, n13:n37, o13:o37") ' Bereich der Wirksamkeit festlegem
' noch mehr Bereiche
' Set RaBereich = Union(Range("h7:h31"), Range("L7:R26"), Range("U7:AA26"), Range("AD7:AJ26"))
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If RaBereich Is Nothing Then Exit Sub
ActiveSheet.Unprotect "Marc" ' Schutz der Tabelle aufheben
Application.EnableEvents = False ' Reaktion auf Zellveränderung abschalten
For Each RaZelle In RaBereich ' Schleife falls mehr als eine Zelle mit einmal verändert
With RaZelle
.NumberFormat = "hh:mm" ' StandardFormat einstellen
If .Value <> "" Then
If IsNumeric(.Value) And InStr(.Value, ":") = 0 And _
InStr(.Value, ",") = 0 And Len(RaZelle) < 5 Then
If Len(Target.Value) > 2 Then
InS = Left(.Value, Len(.Value) - 2)
InM = Right(.Value, 2)
Else
' Stunden haben das Primat
' InS = .Value
' InM = 0
' Minuten haben das Primat
InS = 0
InM = .Value
End If
' überprüfen ob Eingabe in ein Datum umgewandelt werden kann
If IsDate(InS & ":" & InM) Then
.NumberFormat = "hh:mm" ' Zellformat setzen
.Value = InS & ":" & InM ' Zeit in Zelle schreiben
ElseIf InStr(.Text, ":") = 0 Then
MsgBox "Falsche Eingabe"
Target = ""
End If
ElseIf InStr(.Text, ":") = 0 Then
MsgBox "Falsche Eingabe"
Target = ""
End If
End If
If .Value >= 1 Then
MsgBox "Bitte eine Zeit zwischen 0:00 und 23:59 eingeben", vbCritical, "Falsche Zeit eingabe"
Target = ""
Else
Target = .Value
End If
End With
Next RaZelle
ActiveSheet.Protect "Marc" ' Schutz der Tabelle aufheben
Application.EnableEvents = True ' Reaktion auf Zellveränderung einschalten
End Sub
