Prüfung auf Doppelwertigkeit in Spalte
13.01.2021 10:03:06
Sylvia
ich habe eine scheinbar kleine Datenprüfung, die mich aber immer im Kreis laufen lässt.
Ich hoffe, ich erkläre es verständlich.
Ich habe eine Datei mit einer festen Spalte Zimmernummern und einen "Kalender", also ein Tag je Spalte.
Pro Tag sollen die Leute die Zimmernummer oder ein x eintragen. Außerdem gibt es noch die Varianten Zimmernummer+vormittags (XXXXv), Zimmernummer+Nachmittags (XXXXn) und Zimmernummer+abends (XXXXa)
Ein Makro wandelt dann das x in die Zimmernummer um, indem es die Spalte mit den Zimmernummern ausliest.
Jetzt soll Eingabe geprüft werden, ob die Zimmernummer schon vorhanden ist.
Das funktioniert insofern, dass ein Makro prüft, ob die Nummer doppelt ist. Auch erscheint eine Meldung, wenn die Zimmernummer und die Zimmernummer mit einem Zusatz in einer Spalte steht; also XXXX und XXXXv.
Mein Problem ist, dass es noch eine Ausnahme gibt. Es sollen folgende Kombinationen möglich sein:
2x Zimmernummer und Zusatz;
also XXXXv und XXXXnin einer Spalte oder XXXXv und XXXXa
Kann mir jemand helfen? Wie kann das gehen, ohne die vorherigen Prüfungen auszuhebeln?
Hier der Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Set Bereich = Range("k12:AP35")
Set rngUnion = Application.Union(Range(Target.Address), Bereich)
Application.ScreenUpdating = False
If rngUnion.Address Bereich.Address Then Exit Sub
If IsEmpty(TargetRange) Then Exit Sub
x1 = Target.Row
y1 = Target.Column
If UCase(Target) = "X" Then
zi = Cells(x1, 2).Value
Cells(x1, y1).Value = zi
End If
If UCase(Target) = "VM" Then
zi = Cells(x1, 2).Value
Cells(x1, y1).Value = LTrim(Str(zi)) + "v"
End If
If UCase(Target) = "NM" Then
zi = Cells(x1, 2).Value
Cells(x1, y1).Value = LTrim(Str(zi)) + "n"
End If
If UCase(Target) = "A" Then
zi = Cells(x1, 2).Value
Cells(x1, y1).Value = LTrim(Str(zi)) + "a"
End If
zi = Target.Value
If WorksheetFunction.CountIf(Columns(Target.Column), Target.Value) > 1 Then
If Left(zi, 1) = "4" Or Left(Target.Value, 1) = "4" Then MsgBox "Hoppala, der Raum ist _
schon vergeben!"
End If
Application.ScreenUpdating = True
End Sub
https://www.herber.de/bbs/user/142968.xlsm
Vielen Dank!
Viele Grüße
Sylvia