Clever-Excel-Forum

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:

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 Sub

Ich würde mich riesig über eine Lösung freuen.
Vielen lieben Dank im Voraus :)

Liebe Grüße
Niklas

Hallo

sollte so funktionieren.

Code:
  '**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

    If wertnew <> "" Then

      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

      If wertold = "" Then

         Target.Value = wertnew

      Else

         If InStr(1, wertold, wertnew) > 0 Then

            Target.Value = wertold

         Else

            Target.Value = wertold & ", " & wertnew

         End If

      End If

    End If

  End If

Gruß Elex

Hola,

da du es nicht tust....

https://www.office-fragen.de/thread-9944.html
https://www.herber.de/forum/archiv/1756t...tm#1758415

Gruß,
steve1da

Vielen Dank für die schnelle Antwort. Leider funktioniert der Code aber nicht :/
Also ich habe den Code nun so abgeändert und zusätzlich zu deinem Code noch ein "End If" am Ende hinzugefügt, da ich eine Fehlermeldung bekam.
Jetzt kann ich nur noch 1 Begriff aus dem Dropdown auswählen, als wenn es ein ganz normales Dropdow-Menü wäre ohne Mehrfachauswahl.

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

    If wertnew <> "" Then

      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

      If wertold = "" Then

         Target.Value = wertnew

      Else

         If InStr(1, wertold, wertnew) > 0 Then

            Target.Value = wertold

         Else

            Target.Value = wertold & ", " & wertnew

         End If

      End If

    End If

  End If

 End If

Errorhandling:

Application.EnableEvents = True

End Sub

Hi

bei mir geht es.
Für weitere Hilfe solltest du ein Bsp.Datei zur Verfügung stellen, in der es nicht geht.

Du solltest auch Option Explicit verwendest. Dann würden schon mal ein paar Fehler angezeigt.
siehe Rot

Option Explicit

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

Gruß Elex

Vielen Dank, es funktioniert jetzt! :)

Shiggy1993

Elex

steve1da

Shiggy1993

Elex

Shiggy1993