01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31 |
|
Option Compare Text
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr() As String
With Target
If .Address = "$A$1" And .Value <> "" Then ' Feld <<<anpassen>>>
Application.EnableEvents = False
.Value = Replace(UCase$(.Value), " ", "")
If Not .Value Like "####-####-V##" Then
sArr = Split(.Value, "-")
If UBound(sArr) = 2 Then
sArr = Split(.Value, "-")
sArr(0) = Right$("20" & sArr(0), 4)
sArr(1) = Right$("000" & sArr(1), 4)
sArr(2) = Replace(sArr(2), "V", "")
sArr(2) = "V" & Right$("0" & sArr(2), 2)
.Value = Join$(sArr, "-")
' Korrektur möglich
End If
If Not .Value Like "####-####-V##" Then
MsgBox "Die Eingabe '" & .Value & "' ist nicht richtig formatiert!" & vbCr & vbCr _
& "So soll es sein: ####-####-V##", _
vbCritical, "Fehler bei der Eingabe"
End If
End If
Application.EnableEvents = True
End If
End With
End Sub
|