Zellen in Excel sperren wenn in einer anderen Zelle ein Wert eingegeben wurde.

Question

Hallo, wie kann folgendes "Problem" gelöst werden?. Ich habe den
Zellenbereich A:D, E:H, I:L u.s.w. (insgesamt acht Bereiche) und ca. 120
Zeilen. In dem definierten Bereich z.B.: A:D darf nur eine Zelle mit einem
Datum versehen werden z.B in der Zelle der Spalte B, die anderen drei
Zellen "A", "C" und "D" des Bereiches A:D einer Zeile, sollen nach
Eingabe gesperrt werden, gleichzeitig soll der Nutzer aber auch die
Möglichkeit erhalten eine eventuell fehlerhafte Datumseingabe zu
korrigieren.

Hintergrund ist: das jeder Zeile ein Mitarbeiter zugeordnet ist, der
achtmal im Jahr zu unterschiedlichen, vorher nicht festgelegten Zeiten
aufgesucht werden muss. Daher acht Spaltenbereiche zu vier Spalten
und 120 darunter liegende Zeilen, weil 120 Mitarbeiter. Ich habe in
diesem Forum bereits einen sehr gut funktionierenden Lösungshinweis
bekommen, dafür danke ich auf diesem Weg, jedoch stoße ich ob der
Menge an Mitarbeiter (und das ist auch gut so - weil Arbeitsplätze) an
Grenzen, weil VBA-Prozedur zu groß. Und dass muss man erst einmal
hin bekommen. Ich habe das geschafft. Ich weis mir keinen Rat mehr,
aber bevor ich aufgebe frage ich hier nach und hoffe auf Hilfe. Vielen
Dank im Voraus.

Answer 1

was ist mit der Lösung deines ersten Threads zu dem Thema?
www.supportnet.de/t/2497420

Answer 2

Hallo Adrien,

ich gehe mal davon aus, dass in der esten Zeile Überschriften stehen, daher erfolgt die Prüfung ab Zeile 2 bis 130. Aber den Bereich kannst du auf deine Bedürfnisse anpassen.
Ersetze dein vorhandenes Makro durch das folgende:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngPruef As Range

'Prüfung nur im Bereich von A2 bis AF130
If Not Intersect(Target, Range("A2:AF130")) Is Nothing Then

'Abhängig von Eingabespalte den Prüfbereich festlegen
Select Case Target.Column
Case 1 To 4 'Spalte A bis D
Set rngPruef = Range(Cells(Target.Row, 1), Cells(Target.Row, 4))
Case 5 To 8
Set rngPruef = Range(Cells(Target.Row, 5), Cells(Target.Row, 8))
Case 9 To 12
Set rngPruef = Range(Cells(Target.Row, 9), Cells(Target.Row, 12))
Case 13 To 16
Set rngPruef = Range(Cells(Target.Row, 13), Cells(Target.Row, 16))
Case 17 To 20
Set rngPruef = Range(Cells(Target.Row, 17), Cells(Target.Row, 20))
Case 21 To 24
Set rngPruef = Range(Cells(Target.Row, 21), Cells(Target.Row, 24))
Case 25 To 28
Set rngPruef = Range(Cells(Target.Row, 25), Cells(Target.Row, 28))
Case 29 To 32
Set rngPruef = Range(Cells(Target.Row, 29), Cells(Target.Row, 32))
End Select

'Bereich auf eine Eingabe prüfen, falls mehr, dann löschen
With rngPruef
If Application.WorksheetFunction.CountBlank(.Cells) < 3 Then
Application.EnableEvents = False
Target.ClearContents
Application.EnableEvents = True
End If
End With

End If

End Sub

Bei einem so großen Prüfbereich kannst du nicht jede Zelle einzeln ansprechen. Du kannst den Prüfbereich über Target.Row (Zeile) und Target.Column (Spalte) der geänderten Zelle festlegen.

Gruß

M.O.