Herbers Excel/VBA-Archiv

Mehrfachauswahl per dropdown VBA

• Mehrfachauswahl per dropdown VBA von Marius Meier vom 29.09.2020 10:36:46
• AW: Mehrfachauswahl per dropdown VBA - von Marius Meier am 29.09.2020 16:04:09

Betrifft: Mehrfachauswahl per dropdown VBA von: Marius Meier
Geschrieben am: 29.09.2020 10:36:46

Hallo,


vielen Dank schon mal für Eure Hilfe!


Ich habe für bestimmte Felder Dropdown-Felder erstellt. Über einen VBA-Code habe ich es hinbekommen, dass ich auch mehrere Antwortmöglichkeiten auswählen kann. Nun zu meinem Problem:


Die Mehrfachauswahl soll in den Feldern C5-C15 möglich sein (klappt auch gut). In den Feldern C16-C22 soll immer nur eine Antwortmöglichkeit wählbar sein. In den Feldern D16-E18 habe ich wiederum Dropdownfelder, die abhängig von der Auswahl in C16-C18 sind. In diesen Feldern, also D16-E18, soll wieder eine Mehrfachauswahl möglich sein.

Hier mein verwendeter 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
Dim LZ As Integer

'** Errorhandling
On Error GoTo Errorhandling

'** Mehrfachauswahl im definierten Bereich (Bsp. D6:D24) durchführen
'If Not Application.Intersect(Target, Range("D6:D24")) Is Nothing Then
With ActiveSheet
    LZ = .Cells(.Rows.Count, 4).End(xlUp).Row
End With

If Not Application.Intersect(Target, Range("C5:C15")) 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
        wertold = Target.Value
        Target.Value = wertnew
        If wertold <> "" Then
            If wertnew <> "" Then
                If InStr(wertold, wertnew) = 0 Then
                    Target.Value = wertold & ", " & wertnew
                Else
                    Target.Value = wertold
                End If
            End If
        End If
    End If
    Application.EnableEvents = True
End If

Errorhandling:
Application.EnableEvents = True
End Sub

Wenn ich den Bereich von "C5:C15" auf "C5:C15", "D16:E18" ändere, kann ich zwar in D16-E18 eine Mehrfachauswahl vornehmen, aber merkwürdigerweise auch in C16-C18, wo ich immer noch eine Einfachauswahl haben möchte.


Ich hoffe, dass ihr mein Problem verstanden habt. Ich kann leider keine entsprechende Test-Datei hochladen.


Liebe Grüße

Marius

  

Betrifft: AW: Mehrfachauswahl per dropdown VBA
von: Marius Meier
Geschrieben am: 29.09.2020 16:04:09

Hat irgendjemand eine Idee?