Clever-Excel-Forum

Normale Version: Spalte einblenden wenn in Zelle Wert größer Null
Du siehst gerade eine vereinfachte Darstellung unserer Inhalte. Normale Ansicht mit richtiger Formatierung.
Seiten: 1 2 3
Hallo Rudi, 19 

so? 21
[attachment=43451]
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
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
Hallo Petra, 19 

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? 21
[attachment=43614]
Waaaahnsinn!!!  18 18 18

Ganz genau so wollte ich es ...

Lieben Dank!  23

Bis zu meinem nächsten Anliegen ...  33

Grüße Petra
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  22

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
Hallo Petra, 19 

dann noch ein "UnProtect / Protect" rein: 21

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. Dodgy
Oh je, ich habe diese Fehlermeldung erhalten. 
Was hab ich falsch gemacht???? 33 33

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
Hallo Petra, 19 

hier der Code mit Passwort "DeinKennwort". Das kannst du natürlich anpassen: 21

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.
Soooorrryyyy, aber ich bin, glaube ich, zu blöd - wieder die Fehlermeldung Sad

Kannst mir bitte den kompletten Code schicken, BITTE!!!!!

Gruß Petra
Seiten: 1 2 3