doppelte Einträge verhindern
09.01.2004 11:00:55
Ralf
ich habe Ende letzten Jahres ein Problem ins Forum gestellt welches von WernerB ausgiebig bearbeitet wurde. Leider ist dieses Problem für mich immer noch offen. Aus Urlaubstechnischen Gründen konnte ich dies in der Zwischenzeit nicht weiter verfolgen.
Ich befülle fünf Zellenblöcke pro Tabellenblatt mit Zahlen (1 bis 31). Die Zahlen werden automatisch über Drop-down Felder in die Zellen geschrieben. Es gibt 18 Tabellenblätter deren Namen GP 1 bis GP 18 lautet. Ich möchte vermeiden, dass eine Zahl in dem Zellenblock doppelt erscheint. Es soll dann eine Fehlermeldung dem Benutzer angezeigt werden. Die Excel Funktion Gültigkeitsabfrage bringt mich da nicht weiter. Aber so nach diesem Prinzip mit der Funktion gefällt mir das schon sehr gut.
WernerB hat mir da folgendes Makro geschrieben (danke nochmals dafür), dass bei ihm funktioniert, bei mir jedoch nicht.
Beim Öffnen der Arbeitsmappe werden Makros natürlich aktiviert. Kann mir da jemand helfen?
Gruß
Ralf
Hier das Makro von WernerB:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim c As Range
Dim ZBe As String
If Left(ActiveSheet.Name, 2) <> "GP" Then Exit Sub
If Target.Cells.Count > 1 Then Exit Sub
If Target.Value = "" Then Exit Sub
If Intersect(Range("B5:B12"), Target) Is Nothing And _
Intersect(Range("H5:H12"), Target) Is Nothing And _
Intersect(Range("B16:B23"), Target) Is Nothing And _
Intersect(Range("H16:H23"), Target) Is Nothing And _
Intersect(Range("B27:B34"), Target) Is Nothing Then Exit Sub
If Not Intersect(Range("B5:B12"), Target) Is Nothing Then ZBe = "B5:B12"
If Not Intersect(Range("H5:H12"), Target) Is Nothing Then ZBe = "H5:H12"
If Not Intersect(Range("B16:B23"), Target) Is Nothing Then ZBe = "B16:B23"
If Not Intersect(Range("H16:H23"), Target) Is Nothing Then ZBe = "H16:H23"
If Not Intersect(Range("B27:B34"), Target) Is Nothing Then ZBe = "B27:B34"
For Each c In Range(ZBe)
If c.Value = Target.Value And c.Row <> Target.Row Then
Target.Select
MsgBox "Den Eintrag '" & Target.Value & "' gibt es schon !", _
vbOKOnly + vbCritical, _
"Dezenter Hinweis für " & Application.UserName & ":"
Application.EnableEvents = False
ActiveCell.ClearContents
Application.EnableEvents = True
Exit For
End If
Next c
End Sub