Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

Mehrfachauswahl bei Datenüberprüfung, keine doppelte Auswahl
#1
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 VorausSmile

Liebe Grüße
Niklas
Antwortento top
#2
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
Antwortento top
#3
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
Antwortento top
#4
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
Antwortento top
#5
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
Antwortento top
#6
Vielen Dank, es funktioniert jetzt!Smile
Antwortento top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste