doppelte Einträge vermeiden zum 3.
07.01.2004 16:09:40
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. Die Excel Funktion Gültigkeitsabfrage bringt mich da nicht weiter.
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?
Außerdem soll wie es jetzt bei Excel 2003 funktioniert Zellen wirklich gesperrt werden, d.h. man darf diese auch nicht mehr anwählen dürfen. Die Funktion EnableSelection 1 - xlUnlockedCells funktioniert nur bedingt. Nach dem Speichern und dem erneuten Aufrufen der Arbeitsmappe steht der Eintrag wieder auf 0 -xlNoRestrictions und ist somit wirkungslos. Gibt es in Excel 2000 eine solche Funktion die dauerhaft diese Funktion speichert?
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