Excel-Makro Zellen sperren

[marco_jake24]

Hallo Zusammen

Ich habe für ein Excel File folgendes Makro verwendet:

Private Sub Worksheet_Change(ByVal Target As Range)
'** Mehrfachauswahl über DropDown-Liste (Gültigkeitsprüfung)
'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String

'** Errorhandling
On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich (Bsp. B4:B14) durchführen

If Not Application.Intersect(Target, Range("C2:C151")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
  
  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("F2:F152")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
  
  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("E2:E152")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
  
  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("G2:G152")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
  
  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

If Not Application.Intersect(Target, Range("I2:I152")) Is Nothing Then

  '**Range definieren
  Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
  If rngDV Is Nothing Then GoTo Errorhandling
  
  '** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
  If Not Application.Intersect(Target, rngDV) Is Nothing Then
    Application.EnableEvents = False
    wertnew = Target.Value
    Application.Undo
    wertold = Target.Value
    Target.Value = wertnew
    If wertold <> "" Then
      If wertnew <> "" Then
        Target.Value = wertold & ", " & wertnew
      End If
    End If
  End If
  Application.EnableEvents = True
End If

Errorhandling:
Application.EnableEvents = True
End Sub


Zusätzlich soll jetzt noch eingefügt werden, dass wenn der Wert in der Zelle K2:K152 = "aus" ist die Zellen L,M,N & O in der Range 2:152 gesperrt werden und falls "ja" sollen sie zur Bearbeitung zur Verfügung stehen. In allen Kolonnen ausser N habe ich auch eine Dropdown Liste.
Kann mir da jemand weiterhelfen?? 

Ich danke euch im Voraus für eure Hilfe

Gruss Marco

[Gast 123]

Hallo

nach meiner Ansicht ist es sinnvoll die Zellen über Blattschutz zu sperren.   Das geht über ein seperates Makro, oder in Target.
Bei Zellschutz ist zu beachten ob die Zelle in K mit gesperrt werden soll??   Dann kann man sie nie wieder auf "Ja" setzen!!
Cells.Locked=False gibt das ganze Blatt frei.  Falls unerwünscht diesen Befehl bitte löschen!!

Der erste Codeteil bezieht sich auf Target und muss im aktiven Code mit eingebunden werden.  Am besten am Anfang.

mfg  Gast 123

Code:

  Txt = Cells(Target.Row, "K").Value
  If Txt = "aus" Or Txt = "Ja" Then
     ActiveSheet.Unprotect
     If Txt = "aus" Then
        Cells(Target.Row, "L").Resize(1, 4).Locked = True
     ElseIf Txt = "Ja" Then
        Cells(Target.Row, "L").Resize(1, 4).Locked = False
     End If
     ActiveSheet.Protect
     Exit Sub
  End if

Code:

'aus Zelle -Nicht sperren- !!
Sub Ausschalten_1()
Dim AC As Range
  'Blattschutz aufheben
  ActiveSheet.Unprotect
  'ganzes Blatt freigeben
  Cells.Locked = False
  'Schleife für "aus" Zellen sperren
  For Each AC In Range("K2:K152")
     If AC.Value = "aus" Then
        AC.Offset(0, 1).Resize(1, 4).Locked = True
     ElseIf AC.Value = "Ja" Then
        AC.Offset(0, 1).Resize(1, 4).Locked = False
     End If
  Next AC
  'Blattschutz aktivieren
  ActiveSheet.Protect
End Sub


'aus Zelle -Mit sperren- !!
Sub Ausschalten_2()
Dim AC As Range
  'Blattschutz aufheben
  ActiveSheet.Unprotect
  'ganzes Blatt freigeben
  Cells.Locked = False
  'Schleife für "aus" Zellen sperren
  For Each AC In Range("K2:K152")
     If AC.Value = "aus" Then
        AC.Resize(1, 5).Locked = True
     ElseIf AC.Value = "Ja" Then
        AC.Resize(1, 4).Locked = False
     End If
  Next AC
  'Blattschutz aktivieren
  ActiveSheet.Protect
End Sub

[marco_jake24]

Hallo Gast 123
Hallo Zusammen

Da ich noch ein richtiger Anfänger bin mit VBA verstehe ich noch nicht ganz wo ich deinen Code einfügen soll in meinem?!

Die Grundidee war, dass wenn der User im Feld K2 "aus" wählt, dass dann die Zellen L2, M2, N2 und O2 gesperrt werden. Dann wenn bei K3 "ein" gewählt wird die Zellen L3, M3, N3, und O3 frei sind zum bearbeiten und falls dann K3 wieder "aus", dann sollen die Zellen L3, M3, N3 und O3 bearbeitet werden können. Ist so etwas überhaupt möglich? 

Danke nochmals im Voraus für eure Antwort.

Marco

[Gast 123]

Hallo Marco,

ich habe deine Frage jetzt erst gesehen, denke wir sollten erst mal den Code anz laufen bringen.
Der zweite Teil gehört in ein normales Modul Blatt, und besteht aus zwei verschiedenen Makros.

Du kannst beide testen welches besser für euch brauchbar ist.  der Aufruf ob Makro 1 oder 2 erfolgt im Blatt Target
Dort must du dich entscheiden für:  Call Ausschalte_1 oder Call Ausschalten_2  Aber bitte nur eins von beiden.

Den ersten Codeteil must du in Target einfügen, am besten hinter dem Befehl:  On Error GoTo Errorhandling
Dann schau mal was bei der Eingabe mit "aus" in Spalte K passiert.  Diese Zeile sollte jetzt gesperrt sein!

Noch ein Tipp:
zum experimentieren am besten deine Original Datei kopieren und diese Aenderungen zuerst in der Kopie Datei testen.
Wenn es nicht klappt veraendern wir wenigstens nicht die Original Datei.  

mfg  Gast 123