25.05.2022, 09:57
25.05.2022, 15:26
Hallo Case,
vielen Dank, wieder etwas gelernt (wäre ich nie auf eine Lösung gekommen).
Jetzt nur noch für meinen Zweck umbauen.
Gruß
Rudi
vielen Dank, wieder etwas gelernt (wäre ich nie auf eine Lösung gekommen).
Jetzt nur noch für meinen Zweck umbauen.
Gruß
Rudi
08.06.2022, 08:03
Hallo Case,
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.
Vielen lieben Dank!
Grüße Petra
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.
Vielen lieben Dank!
Grüße Petra
08.06.2022, 09:06
Hallo Petra,
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]
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]
08.06.2022, 13:03
Waaaahnsinn!!!
Ganz genau so wollte ich es ...
Lieben Dank!
Bis zu meinem nächsten Anliegen ...
Grüße Petra
Ganz genau so wollte ich es ...
Lieben Dank!
Bis zu meinem nächsten Anliegen ...
Grüße Petra
24.06.2022, 11:06
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
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
24.06.2022, 11:41
Hallo Petra,
dann noch ein "UnProtect / Protect" rein:
Falls du noch ein Kennwort für den Blattschutz, oder andere Parameter vergeben willst, muss der Code entsprechend angepasst werden.
dann noch ein "UnProtect / Protect" rein:
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
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.
24.06.2022, 14:24
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
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
24.06.2022, 14:34
Hallo Petra,
hier der Code mit Passwort "DeinKennwort". Das kannst du natürlich anpassen:
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.
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.
24.06.2022, 14:42
Soooorrryyyy, aber ich bin, glaube ich, zu blöd - wieder die Fehlermeldung
Kannst mir bitte den kompletten Code schicken, BITTE!!!!!
Gruß Petra
Kannst mir bitte den kompletten Code schicken, BITTE!!!!!
Gruß Petra