Clever-Excel-Forum

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

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

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

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

marco_jake24

Gast 123

marco_jake24

Gast 123