Mehrere DropDown mit Mehrfachauswahl in einer Tabelle

[Unimog88]

Liebes Forum,

nach Vorlage:

http://www.clever-excel-forum.de/Thread-...achauswahl
und:
https://www.youtube.com/watch?v=EM8z5oAF5t8

habe ich eine Excel Tabelle mit drei DropDown Menüs erstellt. Jetzt würde ich gerne die Mehrfachauswahl für jedes Menü Programmieren, habe aber keine Erfahrung in VBA. Über die Forumssuche und Google habe ich leider nichts gefunden was mir weiterhilft.


Zusätzlich soll in der Spalte G4:G58 und H4:H58 das gleiche Programm funktionieren. Ich habe verstanden dass es mehrere Lösungsansätze gibt, vielleicht könnt Ihr mir auf die Sprünge helfen?

Die Programmvorlage sieht bis jetzt so aus:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'** Mehrfachauswahl über DropDown-Liste (Gültigkeitsprüfung)
'** Einfügen im Code-Container des betreffenden Arbeitsblattes

'** Dimensionierung der Variablen
Dim rngDV As Range
Dim wert_old As String
Dim wertnew As String

'** Errorhandling
On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich (Bsp. L4:L58) durchführen
If Not Application.Intersect(Target, Range("L4:L58")) Is Nothing Then

'**Range definieren
Set rngDV = Target.SpecialCells(xlCellTypeAllValidation)
If rngDV Is Nothing Then GoTo Errorhandling

'** Prüfen, ob eine gültige Zelle ausgewählt wurde und Werte eintragen
If Not Application.Intersect(Target, rngDV) Is Nothing Then
   Application.EnableEvents = False
   wertnew = Target.Value
   Application.Undo
   wert_old = Target.Value
   Target.Value = wertnew
   If wert_old <> "" Then
     If wertnew <> "" Then
       If Right(wert_old, Len(wertnew)) = wertnew Then
         Target.Value = Left(wert_old, Len(wert_old) - Len(wertnew) - 2)
       Else
         Target.Value = wert_old & ", " & wertnew
       End If
     End If
   End If
End If

End If

Errorhandling:
Application.EnableEvents = True
End Sub

[RPP63]

Hallo!
Und was hat der Code jetzt mit Deiner Datei zu tun (denn der ist ja eher speziell)?
Die solltest Du mal hochladen.
Außerdem sollte daraus hervorgehen, was Du genau vorhast.

Gruß Ralf

[Unimog88]

  Test.zip (Größe: 276,32 KB / Downloads: 0)

Hallo!
Und was hat der Code jetzt mit Deiner Datei zu tun (denn der ist ja eher speziell)?
Die solltest Du mal hochladen.
Außerdem sollte daraus hervorgehen, was Du genau vorhast.

Gruß Ralf

Hallo Ralf,

Danke für deine schnelle Antwort. Es geht um eine Befragung mit verschiedenen Kriterien. Für die Auswahl 3 habe ich die Programmierung so eingefügt bekommen, das mehrere Möglichkeiten ausgewählt werden können. Das würde ich gerne für Auswahl 1 und 2 auch so haben. 

Gruß

Marius

[Unimog88]

Guten Morgen,

So schnell kann es gehen, ich habe gleich zwei Lösungen für mein Problem:
.....

Code:

If Not Application.Intersect(Target, Range("G4:L58")) Is Nothing Then

.....

zum einen kann man den Bereich in dem das Programm läuft einfach erweitern, dafür müssen die Spalten aber neben einander liegen. (vgl. vorher)
....

Code:

If Not Application.Intersect(Target, Range("L4:L58")) Is Nothing Then

....

wenn die Spalten nicht nebeneinander liegen kann man den Arbeitsbereich für das Programm auch auftrennen:
...

Code:

If Not Application.Intersect(Target, Range("G4:I58,J4:J58,M4:M58")) Is Nothing Then

...

Vielleicht kann ja noch jemand was mit der Info anfangen!

guten Rutsch ins neue Jahr,

Gruß

Marius

[Rabe]

Hi Marius,

So schnell kann es gehen, ich habe gleich zwei Lösungen für mein Problem:
[...]
Vielleicht kann ja noch jemand was mit der Info anfangen!

Danke für die Rückmeldung!
Ich glaube, bei diesen Zeilen mit "Intersect" kann das "Application." weggelassen werden, dann wird es etwas kürzer. :)

Es geht auch noch, mehrere Bereiche mit "Union" usw. zusammenzufassen!

Code:

  Dim rngUnion As Range

Set rngUnion = Application.Union(Range("G4:I58", "J4:J58", "M4:M58"))
If Not Intersect(rngUnion, Target) Is Nothing Then

Dann ist der Code aber wieder etwas länger. ;)

oder

Code:

Set rngUnion = Application.Union(Range("G4:I58"), Range("J4:J58"), Range("M4:M58"))

[Unimog88]

Hallo Ralf,

jetzt geht es ja schlag auf schlag, so eine Forumsarbeit finde ich gut!

Vielen Dank dafür
Gruß
Marius