Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Prüfung ob Formel in Zelle vorhanden ist

Prüfung ob Formel in Zelle vorhanden ist
15.05.2014 14:05:31
Judith
Hallo Liebe Excel PowerUser
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
Da meine VBA Kenntnisse wie angegeben bescheiden sind, bin ich für Hilfe dankbar. Ich wollte noch das Excel hochladen, aber das hat ja wahrscheinlich bekannterweise nicht geklappt.
Gruss Judith

5
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Prüfung ob Formel in Zelle vorhanden ist
15.05.2014 15:48:51
EtoPHG
Hallo Judith,
Da bin ich wieder ;-)
Ersetze mal den gesamten Code durch diesen.
Damit sollten eigentlich beide Probleme gelöst sein.
Option Explicit
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 (Len(rc) = 0)
Next rc
' Blattschutz wieder einschalten
Protect "Passwort", AllowInsertingRows:=True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Static lRowsCount As Long
If lRowsCount  UsedRange.Rows.Count Or Target.Column = 15 Then
Worksheet_Activate
End If
End Sub
Gruess Hansueli

Anzeige
Halt, hab noch was vergessen,
15.05.2014 16:16:00
EtoPHG
Hallo Judith,
Sorry...Fehler gemacht...
Die 2te Prozedur muss lauten:
Private Sub Worksheet_Change(ByVal Target As Range)
Static lRowsCount As Long
If lRowsCount  UsedRange.Rows.Count Or Target.Column = 15 Then
Worksheet_Activate
lRowsCount = UsedRange.Rows.Count
End If
End Sub
Gruess Hansueli

Fortschritte
16.05.2014 09:17:36
Judith
Hoi Hansueli
Ja, wir zwei schon wieder! Danke, dass du dir Zeit nimmst!
Das man eine neue Zeile einfügen kann, funktioniert jetzt perfekt!!!
Leider macht mir die Formel in der Spalte 15 immer noch einen Strich durch die Rechnung. Hast du dazu noch eine Idee?
LG Judith

Anzeige
AW: Fortschritte
16.05.2014 14:42:49
fcs
Hallo Judith,
passe das Worksheet_Activate-Makro wie folgt an, dann erfolgt zusätzlich eine Prüfung auf Formel in den Zellen in Spalte 15 (O).
Gruß
Franz
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))
If rc.HasFormula = True Then
Range(Cells(rc.Row, 6), Cells(rc.Row, 8)).Locked = False
Else
Range(Cells(rc.Row, 6), Cells(rc.Row, 8)).Locked = Not (Len(rc) = 0)
End If
Next rc
' Blattschutz wieder einschalten
Protect "Passwort", AllowInsertingRows:=True
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Static lRowsCount As Long
If lRowsCount  UsedRange.Rows.Count Or Target.Column = 15 Then
Worksheet_Activate
lRowsCount = UsedRange.Rows.Count
End If
End Sub

Anzeige
AW: Fortschritte
21.05.2014 10:06:42
Judith
Vielen vielen Dank an Franz und Hansueli. Es funktioniert einfach super!!
LG Judith

342 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige