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?
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
WorkSheet_Change_A_B_G_H_Zeile_einblenden.xlsb (Größe: 22,92 KB / Downloads: 18)
![[-]](https://www.clever-excel-forum.de/images/collapse.png)
