Office: (Office 2010) Dynamische Dropdown mit VBA (selbst erweiternd)

Hallo,

ich möchte eine dynamische Dropdown erstellen, welche nach Auswahl eine neue Zeile mit einer neuen Dropdown einfügt (die Auswahlmöglichkeiten bzw. die Datenquelle bleibt gleich. Unten ist der Code nachzulesen und die Datei habe ich auch angehangen. Das Problem bei dem Code ist:
1) Wenn man den Inhalt einer Dropdown löscht, Eine Zeile löscht, Entf drückt oder bei der Dropdown die Auswahl ändert, wird ständig eine neue Dropdown eingefügt. Es soll maximal 1 leere Dropdown hinzugefügt werden und diese soll auch immer nur am Ende der Dropdown reihung kommen. Könnt ihr mir bei dem Problem helfen? :S

Vielen Dank und Liebe Grüße

Hamme

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("a" & ActiveCell.Row)) Is Nothing Then
    Application.ScreenUpdating = False
    Dim oldrange As Range
    Set oldrange = ActiveCell
    Rows(ActiveCell.Row).Select
    Selection.Copy
    Application.EnableEvents = False
    Rows(ActiveCell.Row + 1).Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    Selection.ClearContents
    Application.EnableEvents = True
    oldrange.Select
    Application.ScreenUpdating = True
End If
End Sub

 

hi, hier hat jemand ein ganz ähnliches problem..: http://www.clever-excel-forum.de/thread-5516.html

 

Hi,

benutze nicht das Change- sondern das Doppelklick-Ereignis:

Code:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim lngGueltigkeiten As Long
    If Target.Column = 1 Then
        On Error Resume Next
        lngGueltigkeiten = Columns(1).SpecialCells(xlCellTypeAllValidation).Count
        On Error GoTo 0
        If lngGueltigkeiten > 0 Then
            If Not Intersect(Target, Columns(1).SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
                If Intersect(Target.Offset(1, 0), _
                    Target.SpecialCells(xlCellTypeAllValidation)) Is Nothing Then
                    Cancel = True
                    Application.ScreenUpdating = False
                    Target.Copy Target.Offset(1, 0)
                    Target.Offset(1, 0).ClearContents
                    Application.ScreenUpdating = True
                End If
            End If
        End If
    End If
End Sub

Bis später,
Karin

 

Ich sehe die Lösung bin nur zu Doof die bei mir umzusetzen. Wo liegt mein Denkfehler? Ziel ist es wie oben - Dropdown - Auswahl - und die ganze Zeile soll neu als leeres Dropdown und Beschreibung erstellt werden. Den Anhang Fobiliste_erweitert.xlsm betrachten

 

Code:

                    Application.ScreenUpdating = False
                    Target.Copy Target.Offset(1, 0)
                    Target.Offset(1, 0).ClearContents
                    Application.ScreenUpdating = True

.Copy [.Paste] ist genauso wie .Select eigentlich fast nie nötig, oder? Falls ich die Aufgabe richtig überflogen habe, reicht:

Code:

                    Target.Offset(1).Validation = Target.Validation

 

Deine Gültigkeitszellen sind nicht in Spalte A (1) sondern in Spalte B (2) - du musst also an allen Stellen wo Columns(1) steht die 1 in 2 ändern.

Bis später,
Karin

 

Dein Code löst einen 'Laufzeitfehler 438 aus: Objekt unterstützt diese Eigenschaft oder Methode nicht', was auch logisch ist, denn Validation ist ein Objekt und keine Zelleigenschaft wie z.B. der Zellinhalt oder Zellfarbe u.ä., die man mittels "=" übertragen kann.

Bis später,
Karin

 

Hm ... dann ist das aber nicht kongruent, denn Formeln, Werte und bedingte Formate kann ich doch auch an andere Zellen weitergeben. Aber da es für alles einen Grund gibt, ist es eben so. Eine Gültigkeit ist doch auch nur so etwas wie eine Formel.

Habe mich schon öfters gewundert, dass nicht das gesamte Einfügen-Dialogfeld sich so in VBA wiederfindet (außerhalb von PasteSpezial).

 

Auch eine bedingte Formatierung kannst du nicht per "=" auf eine andere Zelle übertragen.

Bis später,
Karin