Hallo Thomas,
Du hast in der Tabelle 2x das Ereignis Change das geht nicht.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim s%, m%
'Soll nur bei einer Eingabe in Spalte A wirksam werden:
If Target.Column = 6 Or Target.Column = 7 Or Target.Column = 8 Or Target.Column = 9 Or _
Target.Column = 22 Or Target.Column = 23 Then
With Cells(Target.Row, Target.Column)
If .Value = "" Then Exit Sub
If IsNumeric(.Value) And InStr(.Value, ":") = 0 And InStr(.Value, ",") = 0 Then
.NumberFormat = "[h] : mm"
If Len(.Value) > 2 Then
s = Left(.Value, Len(.Value) - 2)
m = Right(.Value, 2)
Else
s = .Value
m = 0
End If
.Value = s & ":" & m
End If
End With
End If
'* H. Ziplies *
'* 16.05.07 *
'* erstellt von Hajo.Ziplies@web.de *
'* http://Hajo-Excel.de/
' erster Buchstabe in Zelle Groß Rest Klein
Dim RaBereich As Range, RaZelle As Range
' Bereich der Wirksamkeit
Set RaBereich = Range("F10:F40")
' noch mehr Bereiche
' Set RaBereich = Union(Range("C11:AG11 , C13:AG13, C15:AG15 , C17:AG17 , C19:AG19 , C21: _
AG21 , C27:AE27 , C29:AE29, C31:AE31, C33:AE33"), _
' Range("C35:AE35, C37:AE37, C43:AG43, C45:AG45 , C47:AG47 , C49:AG49 ,C51:AG51 , C53: _
AG53 , C59:AF59 , C61:AF61 , C63:AF63 , C65:AF65"), _
' Range("C67:AF67 , C69:AF69 , C75:AG75 , C77:AG77 , C79:AG79 , C81:AG81 , C83:AG83 , _
C85:AG85 ,C91:AF91 , C93:AF93 , C95:AF95 , C97:AF97"), _
' Range("C99:AF99 , C101:AF101, C107:AG107 , C109:AG109 , C111:AG111 , C113:AG113 , C115: _
AG115 , C117:AG117 , C123:AG123 , C125:AG125"), _
' Range("C127:AG127 , C129:AG129 , C131:AG131 , C133:AG133 , C139:AF139 , C141:AF141 , _
C143:AF143 , C145:AF145 , C147:AF147 , C149:AF149"), _
' Range("C155:AG155, C157:AG157 , C159:AG159 , C161:AG161 , C163:AG163 , C165:AG165 , _
C171:AF171 , C173:AF173 , C175:AF175 , C177:AF177 "), _
' Range("C179:AF179 , C181:AF181, C187:AG187 , C189:AG189 , C191:AG191 , C193:AG193 , _
C195:AG195 , C197:AG197"))
' die veränderten Zellen die im überwachten Bereich liegen auf die Variable schreiben
Set RaBereich = Intersect(RaBereich, Range(Target.Address))
If Not RaBereich Is Nothing Then ' geänderte Zellen liegen im überwachten _
Bereich
' ActiveSheet.Unprotect ' Schutz aufheben
Application.EnableEvents = False ' Reaktion auf Eingabe aus
Application.ScreenUpdating = False ' Bildschirmaktualisierung aus
For Each RaZelle In RaBereich ' Schleife über alle geänderten Zellen im ü _
berwachten Bereich
If RaZelle "" Then
' Schreibweise ändern entsprechend Vorgabe
RaZelle.Value = UCase(Mid(RaZelle.Value, 1, 1)) & LCase(Mid(RaZelle.Value, 2, _
Len(RaZelle.Value) - 1))
End If
Next RaZelle
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
Application.EnableEvents = True ' Reaktion auf Eingabe ein
' ActiveSheet.protect ' Schutz setzen
End If
Set RaBereich = Nothing ' Variable löschen
End Sub
' oder
' MsgBox WorksheetFunction.Proper(Range("A1").Value)
' PROPER ist GROSS2
' von Boris