AW: msgbox wenn gleich.
07.09.2017 13:44:02
Peter
Hallo,
ich würde das ganze nicht beim ändern machen, sondern einfach die Vorgabe geben,
dass jeder nach eintragung die Daten überprüfen lass soll per makro.
Habe auf die Schnelle einen Code geschrieben...
Hier ist eine Beispielmappe: https://www.herber.de/bbs/user/116085.xlsm
Geprüft wird, ob es in Spalte A, nochmals die Id gibt, des Nutzers.
Falls ja, dann Prüft er ob in der Zeile des Nutzers + der aktuellen Spalte
bereits ein wert steht.
Falls ja gibts ne MessageBox und der neu eingetragene wert wird gelöscht.
Falls nein...dann nix
Bereich in dem Geprüft wird ist: G8 bis alle Spalten bis Zeile 18.
Hier nur Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim id, users() As Variant
Dim rng As Range, c
Dim counter As Long
Dim targetAddress
Dim firstAddress
Dim varItems
If Target.Row > 7 And Target.Row 6 Then
id = Cells(Target.Row, 1).Value
If id = "" Then Exit Sub
targetAddress = Target.Row
Set rng = Range(Cells(7, 1), Cells(17, 1))
Set c = rng.Find(id, LookIn:=xlValues, LookAt:=xlWhole)
If Not c Is Nothing Then
firstAddress = c.Address
Do
ReDim Preserve users(counter)
users(counter) = c.Row
counter = counter + 1
Set c = rng.FindNext(c)
Loop While c.Row targetAddress And c.Address firstAddress And Not c Is _
Nothing
End If
If IsEmpty(users) Or UBound(users) = 0 Then Exit Sub
For Each varItem In users
If Cells(Target.Row, Target.Column).Value "" And Cells(varItem, Target.Column). _
Value "" Then
MsgBox "Kollege hat Tag bereits belegt"
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
Next varItem
End If
End Sub