Prüfung ob Formel in Zelle vorhanden ist
15.05.2014 14:05:31
Judith
Ich habe nochmal eine Frage. Das folgende Skript prüft pro Zeile in der Spalte 15, welche Zelle leer ist. Wenn nein, werden die betreffenden Zellen der Spalten 6 - 8 gesperrt. Das funktioniert an dieser Stelle prima (danke Hansueli ;)). Kleiner Schönheitsfehler ist noch, dass wenn eine neue Zeile eingefügt wird, das Skript nur mit einem Wechsel des Tabellenblatts nochmal angestossen wird und somit auch die neue Zeile abgefragt wird. Aber das ist nicht so tragisch.
Jetzt habe ich noch das Problem, dass in einigen Zellen der Spalte 15 Formeln stehen (die einen Eintrag in der Zeile abfragen und ein "" als Ergebnis haben können) und somit mit Zellen gesperrt werden, obwohl diese bearbeitet werden müssen.
Meine Idee wäre eingentlich eine Lösung mit der Funktion HasFormula und wenn False dann prüfe ob Zelle leer (nein, sperre die Zellen).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rc As Range
If Target.Column = 15 Then ' Eingaben in Spalte 5 (E) werden geprüft
Application.EnableEvents = False
' Blattschutz aufheben
Unprotect "Passwort"
For Each rc In Target
' Zellen in Spalte 6-8 (F,G,H) in dieser Zeile werden gesperrt
Range(Cells(rc.Row, 6), Cells(rc.Row, 8)).Locked = Not IsEmpty(rc)
Next rc
' Blattschutz wieder einschalten
AllowInsertingRows = True
Protect "Passwort", AllowInsertingRows:=True
Application.EnableEvents = True
End If
End Sub
---------------
Private Sub Worksheet_Activate()
Dim rc As Range
Application.EnableEvents = False
' Blattschutz aufheben
Unprotect "Passwort"
For Each rc In Range(Cells(2, 15), Cells(Rows.Count, 15).End(xlUp))
Range(Cells(rc.Row, 6), Cells(rc.Row, 8)).Locked = Not IsEmpty(rc)
Next rc
' Blattschutz wieder einschalten
Protect "Passwort", AllowInsertingRows:=True
Application.EnableEvents = True
End Sub
Gruss Judith