Dynamische Dropdown mit VBA (selbst erweiternd)

[hamme]

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. 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

[shift-del]

Hallo

Warum VBA und nicht einfach eine weitere formatierte Tabelle?
Formeln, Formatierungen und Gültigkeitsprüfungen werden automatisch kopiert.

[hamme]

Es soll ja automatisch eine Dropdown hinzugefügt werden, sobald man seine Auswahl in der Dropdown getätigt hat. Da Mehrere Tabellen mit Dropdowns untereinander stehen muss auch automatisch eine weitere Zeile mit der neuen Dropdown erstellt werden.
Ist mein Problem verständlich? :S

Grüße

Hamme

[shift-del]

Es soll ja automatisch eine Dropdown hinzugefügt werden, sobald man seine Auswahl in der Dropdown getätigt hat.

Das geht dann also bis Zeile 1048576.

Da Mehrere Tabellen mit Dropdowns untereinander stehen muss auch automatisch eine weitere Zeile mit der neuen Dropdown erstellt werden.
Ist mein Problem verständlich? :S

Vielleicht reicht es ja schon die "mehreren Tabellen" nebeneinander zu stellen.

[hamme]

Das geht dann also bis Zeile 1048576.

Vielleicht reicht es ja schon die "mehreren Tabellen" nebeneinander zu stellen.

Das Tabellendesign und die Zweckmäßigkeit gibt es nicht her die Tabellen nebeneinander zu stellen. Sie müssen untereinander stehen. Es soll keine Zellenbegrenzung vorgegeben werden, das heißt man kann dies dann unendlich erweitern. Meines Wissens sind diese Anforderungen nur mit VBA möglich.

Liebe Grüße

Hamme

[schauan]

Hallöchen,

ein erster Ansatz wäre das:

Code:

On Error Resume Next
If ActiveCell.Offset(1, 0).Validation.Formula1 <> "" Then
  If Err.Number = 0 Then Exit Sub
End If
On Error GoTo 0

Damit wird Dein Makro verlassen, wenn unter der "bearbeiteten" Zelle bereits eine Gültigkeit ist. Allerdings müsste man das noch etwas ausbauen, wenn Du z.B. eine ganze Zeile löschst.

[snb]

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Columns(1).SpecialCells(-4174)) Is Nothing Then Target.Offset(1).Validation.Add Target.Validation.Type, , , Target.Validation.Formula1
End Sub