Clever-Excel-Forum

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

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

[attachment=3662]

(22.12.2015, 11:31)RPP63 schrieb: [ -> ]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

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

Hi Marius,

(30.12.2015, 09:07)Unimog88 schrieb: [ -> ]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"))

Hallo Ralf,

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

Vielen Dank dafür
Gruß
Marius

Unimog88

RPP63

Unimog88

Unimog88

Rabe

Unimog88