Zellen sperren

Marc · 2020-10-18T16:27:37+00:00

Hallo zusammen, ich möchte gerne, dass Zellen gesperrt werden wenn eine Bedingung erfüllt ist. Über Datenprüfung/Gültigkeit habe ich aber schon eine Liste angelegt was nur ausgewählt werden darf. (Zahlen von 1-3) Somit fällt diese Möglichkeit wohl weg? Konkret heißt das: WENN in G9 ein nein steht, dann sollen die Zellen F12-F50 gesperrt werden. Gleichzeitig soll aber nur die Möglichkeit der Eingabe von Zahlen 1, 2, 3 bestehen wenn in G9 ein ja steht. Geht das irgendwie? Danke an alle für Eure Hilfe im Voraus. Gruß Marc

Hallo Nepumuk,
kurze Frage: hast Du vielleicht ne Idde warum der Code von Dir in einem anderen Tabellenblatt von mir nicht funzt?
Hier mal der VBA Code.
Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$G$9" Then
Unprotect
Range("F12:F500").Locked = Target.Text = "Doppel (entfällt)"
Protect
End If
End Sub

Private Sub CommandButton1_Click()
ActiveSheet.Unprotect
If [A1,A3,A4].Value = 0 Then
newHour = Hour(Now())
newMinute = Minute(Now())
newSecond = Second(Now()) + 5
waitTime = TimeSerial(newHour, newMinute, newSecond)
Application.Wait waitTime
Range("H2:H7").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.Color = 255
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
If [A4].Value = 1 Or [A5].Value = 1 Then
Range("H2:H7").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
End With
End If
End If
ActiveSheet.Protect
Range("B6").Select
End Sub

Stört sich da irgendetwas gegenseitig?
"nein" habe ich durch "Doppel (entfällt)" ersetzt.
Gruß Marc
https://www.herber.de/bbs/user/140955.xlsx

Hallo Nepumuk,
kurze Frage: mein Makro zum löschen funzt jetzt nicht mehr, obwohl ich am Anfang den Blattschutz aufhebe.
Hast Du da auch ne Idee zu.
Hier der VBA Code:

Sub Aufstellung_Gast_löschen()
' Aufstellung_Gast_löschen Makro
ActiveSheet.Unprotect
Range("D12:D500").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-99
Range("F12:F500").Select
Selection.ClearContents
Range("J12:J500").Select
Selection.ClearContents
ActiveWindow.SmallScroll Down:=-102
Range("H2:H7").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Fett"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorDark1
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
ActiveSheet.Protect
End With
If [A2].Value >= 1 Or [A2].Value >= 0 Then
Range("D12").Select
End If
If [A2].Value >= 2 Then
Range("D63").Select
ActiveWindow.SmallScroll Down:=51
End If
If [A2].Value >= 3 Then
Range("D113").Select
ActiveWindow.SmallScroll Down:=25
End If
If [A2].Value >= 4 Then
Range("D167").Select
ActiveWindow.SmallScroll Down:=54
End If
If [A2].Value >= 5 Then
Range("D223").Select
ActiveWindow.SmallScroll Down:=56
End If
If [A2].Value >= 6 Then
Range("D272").Select
ActiveWindow.SmallScroll Down:=49
End If
If [A2].Value >= 7 Then
Range("D323").Select
ActiveWindow.SmallScroll Down:=51
End If
If [A2].Value >= 8 Then
Range("D374").Select
ActiveWindow.SmallScroll Down:=51
ActiveSheet.Protect
End If
End Sub

Bei Range("F12:F500").Select bleit er stehen.
Ich verstehe nur nicht warum, da ich ja den Schutz aufhebe.
Gruß Marc

Forumthread: Zellen sperren

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Zellen sperren

Forumthread: Zellen sperren

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread