12.05.2020, 10:04
Hallo zusammen,
ich habe mit Hilfe des folgenden Videos ( https://www.youtube.com/watch?v=EM8z5oAF5t8 ) eine Mehrfachauswahl bei Datenüberprüfung mit Hilfe eines Dropdown-Menüs erstellt. Es funktioniert auch alles soweit.
Wenn ich jedoch mehrfach hintereinander den selben Begriff aus dem Dropdown auswähle, erscheint dieser immer wieder hintereinander. Ich möchte gerne das ein bereits ausgewählter Begriff aus dem Dropdown nicht nocheinmal ausgewählt werden kann. Kann man den Code vllt anpassen, sodass ein bereits ausgewählter Begriff nicht nocheinmal ausgewählt werden kann?
Das ist der aktuelle Code:
Ich würde mich riesig über eine Lösung freuen.
Vielen lieben Dank im Voraus![[Bild: smile.gif]](https://www.clever-excel-forum.de/images/smilies/smile.gif)
Liebe Grüße
Niklas
ich habe mit Hilfe des folgenden Videos ( https://www.youtube.com/watch?v=EM8z5oAF5t8 ) eine Mehrfachauswahl bei Datenüberprüfung mit Hilfe eines Dropdown-Menüs erstellt. Es funktioniert auch alles soweit.
Wenn ich jedoch mehrfach hintereinander den selben Begriff aus dem Dropdown auswähle, erscheint dieser immer wieder hintereinander. Ich möchte gerne das ein bereits ausgewählter Begriff aus dem Dropdown nicht nocheinmal ausgewählt werden kann. Kann man den Code vllt anpassen, sodass ein bereits ausgewählter Begriff nicht nocheinmal ausgewählt werden kann?
Das ist der aktuelle Code:
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. B4:B14) durchführen
If Not Application.Intersect(Target, Range("G12:G9999, H12:H9999, I12:I999")) 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 '** trägt das ausgewählte in die Variable "wertnew" ein
Application.Undo '** macht es sofort rückgängig
wertold = Target.Value '** es wird geguckt was vorher drin stand und wird in die Variable "wertold" eingetragen
Target.Value = wertnew
If wertold <> "" Then
If wertnew <> "" Then
Target.Value = wertold & ", " & wertnew
End If
End If
End If
Application.EnableEvents = True
End If
Errorhandling:
Application.EnableEvents = True
End SubIch würde mich riesig über eine Lösung freuen.
Vielen lieben Dank im Voraus
Liebe Grüße
Niklas