Zeilen bedingt sperren und freigeben

Hallo
Habe folgende Frage
Ich möchte in einem Excel Sheet mehrere Zeilen sperren bzw freigeben abhängig von dem Inhalt in
Spalte A.
With Sheets(4)
.Unprotect "11"
.Cells.Locked = True
.Range("G" & zeile & ":AK" & zeile).Locked = False
.Range("G" & zeile + (1 * Offset) & ":AK" & zeile + (1 * Offset)).Locked = False
.Range("G" & zeile + (2 * Offset) & ":AK" & zeile + (2 * Offset)).Locked = False
.
.
.
.Protect "11"
End With
das habe ich bisher benutzt
Nun möchte ich aber die Zeilen sortieren.
Ich brauche also eine Makro Ergänzung, die mir die ersten 2000 Zeilen der Spalte A durchsucht
und bei Übereinstimmung mit einer Variable die ganze Zeile ertsperrt.
Hat da jemand eine Idee... die auch noch schnell genug funktioniert.
Danke

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Enrico,
zum Sortieren ist es wahrscheinlich besser, wenn du den Blattschutz komplett aufhebst.
Damit das Sortieren (muß unter Blattschutz als zulässig markiert sein) funktioniert müssen alle vom Sortiervorgang betroffenen Zellen entsperrt sein.
Nachfolgend zwei Prozeduren zum Suchen und Sperren von Zeilen. Die Prozeduren sind etwa gleich schnell.
Gruß
Franz


Sub SuchenKriterium()
'Eingabewert in Spalte A suchen und Zeile entsperren
Dim objWks As Worksheet, lngZeile As Long, varSuchen As Variant
Application.ScreenUpdating = False
varSuchen = InputBox(Prompt:="Suchbegriff?")
If varSuchen = "" Then Exit Sub
If IsNumeric(varSuchen) Then varSuchen = CDbl(varSuchen)
Set objWks = ActiveSheet
With objWks
.Unprotect Password:="11"
'Alle Zellen sperren
.Cells.Locked = True
For lngZeile = 1 To .Cells(.Rows.Count, 1).Row
If .Cells(lngZeile, 1) = varSuchen Then
.Rows(lngZeile).Cells.Locked = False
End If
Next
.Protect Password:="11"
End With
Application.ScreenUpdating = False
MsgBox "fertig"
End Sub
Sub SuchenKriterium2()
'Eingabewert in Spalte A suchen und Zeile entsperren
Dim objWks As Worksheet, lngZeile As Long, varSuchen As Variant
Dim objBereich As Range
Application.ScreenUpdating = False
varSuchen = InputBox(Prompt:="Suchbegriff?")
If varSuchen = "" Then Exit Sub
If IsNumeric(varSuchen) Then varSuchen = CDbl(varSuchen)
Set objWks = ActiveSheet
With objWks
.Unprotect Password:="11"
'Alle Zellen sperren
.Cells.Locked = True
'1. Fundstelle suchen
For lngZeile = 1 To .Cells(.Rows.Count, 1).Row
If .Cells(lngZeile, 1) = varSuchen Then
Set objBereich = .Rows(lngZeile)
Exit For
End If
Next
'weitere Fundstelle suchen
For lngZeile = lngZeile + 1 To .Cells(.Rows.Count, 1).Row
If .Cells(lngZeile, 1) = varSuchen Then
Set objBereich = Application.Union(objBereich, .Rows(lngZeile))
End If
Next
If objBereich Is Nothing Then
MsgBox "Suchbegriff """ & varSuchen & """ nicht gefunden!"
Else
objBereich.Cells.Locked = False
MsgBox "fertig"
End If
.Protect Password:="11"
End With
Application.ScreenUpdating = False
End Sub

Beliebteste Forumthreads (12 Monate)

Zeilen bedingt sperren und freigeben

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zeilen bedingt sperren und freigeben

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread