Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
400to404
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
400to404
400to404
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

wenn dann einzelne Zellen sperren

wenn dann einzelne Zellen sperren
TinoB
hallo excelspezies,
habe wieder folgendes problem. fand im archiv folgenden code zum sperren von einzelnen zellen. nun möchte ich aber, das die bedingung nicht nur in Zeile1, sondern dynamisch in alle weiteren zeilen gilt. könnte mir da jemand helfen und dies so umbauen?
Danke
Tino
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Unprotect
If Cells(1, 1) = 10 Then
Range(Cells(1, 2), Cells(1, 4)).Locked = True
Else
Range(Cells(1, 2), Cells(1, 4)).Locked = False
End If
If Cells(1, 1) = 20 Then
Range(Cells(1, 2), Cells(1, 4)).Locked = True
Else
Range(Cells(1, 2), Cells(1, 4)).Locked = False
End If
ActiveSheet.Protect
End Sub


Private Sub Worksheet_Activate()
ActiveSheet.EnableSelection = xlUnlockedCells
End Sub

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: wenn dann einzelne Zellen sperren
Christoph
Hi Tino,
zunächst solltest du in einer Worksheet_Change Anweisung den Bereich soweit wie möglich begrenzen um nicht bei jeder Änderung in irgendeiner Zelle direkt das makro aufzurufen.
z.B: Begrenzung auf Spalte A mit
If Target.Column > 1 Then Exit Sub
Wenn du deinen Code auf mehrere Zeilen ausdehnen willst, dann kannst du z.B die letzte Zeile mit einem Eintrag in Spalte A finden mit:
LRow = Cells(Rows.Count, 1).End(xlUp).Row
Und jetzt für alle Zellen in Spalte A bis zur letzten genutzten Zeile eine entsprechende Schleife bauen.
zB so:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer, LRow As Integer
If Target.Column > 1 Then Exit Sub
LRow = Cells(Rows.Count, 1).End(xlUp).Row
ActiveSheet.Unprotect
For i = 1 To LRow
If Cells(i, 1) = 10 Or Cells(i, 1) = 20 Then
Range(Cells(i, 2), Cells(i, 4)).Locked = True
Else
Range(Cells(i, 2), Cells(i, 4)).Locked = False
End If
Next i
ActiveSheet.Protect
End Sub

Anzeige
danke, Christoph funktioniert (o.T.)
TinoB
.
Danke für die Rückmeldung (o.T.)
23.03.2004 16:59:01
Christoph

323 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige