nochmals vielen Dank für Deine Hilfe. Ich habe nun die Datei angepasst, und dabei bemerkt, dass in den meisten Fällen bei der Auswahl der Produkte eine "1" eingegeben wird, in ganz seltenen Fällen wird es auch mal ein anderer Wert. Ich habe nun durch eine Formel versucht, diese Anforderung zu automatisieren, was aber nun dazu führt, dass sich das nächste Dropdown-Auswahlfeld jetzt nicht mehr einblendet, wie ja durch das Makro super geklappt hat.
Könntest Du da nochmals drüber schauen, liegt es vielleicht an der Formel, ist da ein Fehler drin oder muß man hier das Makro erweitern.
bei Ereignismakros - was "Private Sub Worksheet_Change(ByVal Target As Range)" ja darstellt - ist die Arbeitsweise mit dem Tabellenblatt natürlich entscheidend. Jetzt reagiert der Code, wenn du in Spalte B, respektive H, etwas eingibst bzw. In A oder G etwas auswählst. So OK? [attachment=43614]
Hallo zusammen, dank Eurer Hilfe ist mein Projekt nun so gut wie fertig.
Um dass die ganze Arbeit nicht umsonst war, wollte ich nun das Eingabeblatt schützen. Der Schutz funktioniert soweit, jedoch funktioniert das dann nicht mehr mit der Auswahl in Spalte A und der Eingabe in Spalte B
Ich habe mal ein bisschen gegoogelt, was ich gefunden habe, war, dass man das Makro dementsprechend anpassen muß...
DA BIN ICH ABER SO WAS VON RAUS
Kann da mal bitte jemand drüber schauen....
Vielen Dank! Gr. Petra
Code:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fin Application.ScreenUpdating = False If Not Target.CountLarge > 1 Then If Target.Value <> "Bitte auswählen" Then If Not Intersect(Target, Range("A:B,G:H")) Is Nothing Then With Application .EnableEvents = False Target.Offset(1, 0).EntireRow.Hidden = False .Goto Cells(Target.Row + 1, Target.Column) End With End If End If End If Fin: Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub 'Private Sub Worksheet_Change(ByVal Target As Range) ' On Error GoTo Fin ' Application.ScreenUpdating = False ' If Not Target.CountLarge > 1 Then ' If Not IsEmpty(Target) And IsNumeric(Target) Then ' If Not Intersect(Target, Range("B:B,H:H")) Is Nothing Then ' With Application ' .EnableEvents = False ' Target.Offset(1, 0).EntireRow.Hidden = False ' .Goto Cells(Target.Row + 1, Target.Column - 1) ' End With ' End If ' End If ' End If 'Fin: ' Application.ScreenUpdating = True ' Application.EnableEvents = True ' If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description 'End Sub
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fin Application.ScreenUpdating = False If Not Target.CountLarge > 1 Then If Target.Value <> "Bitte auswählen" Then If Not Intersect(Target, Range("A:B,G:H")) Is Nothing Then Me.Unprotect With Application .EnableEvents = False Target.Offset(1, 0).EntireRow.Hidden = False .Goto Cells(Target.Row + 1, Target.Column) End With End If End If End If Fin: Me.Protect Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub
Falls du noch ein Kennwort für den Blattschutz, oder andere Parameter vergeben willst, muss der Code entsprechend angepasst werden.
Oh je, ich habe diese Fehlermeldung erhalten. Was hab ich falsch gemacht????
Ja ein Kennwort für Blattschutz wäre klasse. Vorläufig reicht ja mal "PASSWORT", ich kann das ja später noch anpassen, oder?
Gruß Petra
Code:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fin Application.ScreenUpdating = False If Not Target.CountLarge > 1 Then If Target.Value <> "Bitte auswählen" Then If Not Intersect(Target, Range("A:B,G:H")) Is Nothing Then With Application .EnableEvents = False Target.Offset(1, 0).EntireRow.Hidden = False .Goto Cells(Target.Row + 1, Target.Column) End With End If End If End If Fin: Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub 'Private Sub Worksheet_Change(ByVal Target As Range) ' On Error GoTo Fin ' Application.ScreenUpdating = False ' If Not Target.CountLarge > 1 Then ' If Not IsEmpty(Target) And IsNumeric(Target) Then ' If Not Intersect(Target, Range("B:B,H:H")) Is Nothing Then ' With Application ' .EnableEvents = False ' Target.Offset(1, 0).EntireRow.Hidden = False ' .Goto Cells(Target.Row + 1, Target.Column - 1) ' End With ' End If ' End If ' End If 'Fin: ' Application.ScreenUpdating = True ' Application.EnableEvents = True ' If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description 'End Sub
Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fin Application.ScreenUpdating = False If Not Target.CountLarge > 1 Then If Target.Value <> "Bitte auswählen" Then If Not Intersect(Target, Range("A:B,G:H")) Is Nothing Then Me.Unprotect With Application .EnableEvents = False Target.Offset(1, 0).EntireRow.Hidden = False .Goto Cells(Target.Row + 1, Target.Column) End With End If End If End If Fin: Me.Protect Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub
hier der Code mit Passwort "DeinKennwort". Das kannst du natürlich anpassen:
Code:
Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo Fin Application.ScreenUpdating = False If Not Target.CountLarge > 1 Then If Target.Value <> "Bitte auswählen" Then If Not Intersect(Target, Range("A:B,G:H")) Is Nothing Then Me.Unprotect Password:="DeinKennwort" With Application .EnableEvents = False Target.Offset(1, 0).EntireRow.Hidden = False .Goto Cells(Target.Row + 1, Target.Column) End With End If End If End If Fin: Me.Protect Password:="DeinKennwort" Application.ScreenUpdating = True Application.EnableEvents = True If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & " " & Err.Description End Sub
Die Fehlermeldung ist klar - du hast mindestens zwei "Private Sub Worksheet_Change(ByVal Target As Range)" - das geht nicht. Es darf nur ein Code mit dieser Bezeichnung aktiv sein.
Spalte einblenden wenn in Zelle Wert größer Null
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
