Dropdown-Menü mit Mehrfachwahl einzelne Inhalte löschen

[Bienentreu]

Ich habe mir mit Hilfe des Internets eine Dropdown-Menü mit Mehrfachwahl erstellt, Mein Wissen dahingehend geht gegen 0.
In dieser Liste möchte ich einzelne Inhalte löschen, was leider so, wie ich es mit dahcte, nicht funktioniert.

Der VBA-Code, den ich im Internet gefunden habe, sieht so aus:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
    Application.EnableEvents = False

    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
    Target.Value = xValue2
    If xValue1 <> "" And xValue2 <> "" Then
        If Not (xValue1 = xValue2 Or _
                InStr(1, xValue1, delimiter & xValue2) > 0 Or _
                InStr(1, xValue1, xValue2 & delimiter) > 0) Then
            Target.Value = xValue1 & delimiter & xValue2
        Else
            Target.Value = xValue1
        End If
    End If

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Kann mir jemand behilflich sein?

Gruß Ralf

[Ralf A]

Ich habe mir mit Hilfe des Internets eine Dropdown-Menü mit Mehrfachwahl erstellt, Mein Wissen dahingehend geht gegen 0.
In dieser Liste möchte ich einzelne Inhalte löschen, was leider so, wie ich es mit dahcte, nicht funktioniert.

Moin,

geht auch ohne VBA. Schau mal hier. Wenn Du Einträge löschen willst, dann machst Du das in der Quelle.

[Bienentreu]

Und wenn ioch einzelne, vorher ausgewählte Inhalte abwählen möchte?

[Egon12]

Hallo,
 
meinst du in DD-Menü steht: Montag;Dienstag;Mittwoch;Donnerstag
 
und die Ausgabe nach Auswahl in Zelle ist: 
1. Aw Montag
2. Aw Montag, Donnerstag
3. Aw Montag, Donnerstag, Mittwoch
... ?
 
Oder soll ein einmal ausgewählter Wert aus dem Menü des DropDowns entfernt werden (Dies kann man mit Formeln machen).
 
 
Gruß Uwe

[Ralf A]

Und wenn ioch einzelne, vorher ausgewählte Inhalte abwählen möchte?

Das ist unter Beachtung einer vernünftigen und konsistenten Datenhaltung ein No Go. Da müsstest Du schon sehr genau wissen, ob Du das willst, denn dann müsstest Du die referentielle Integrität beachten und alle Datensätze die den gelöschten Inhalt beinhalten ebenfalls löschen. Davon kann ich Dir nur abraten!  Oder Du verzichtest auf das Dropdown an dieser Stelle und holst Dir den Wert von anderer Stelle... Könnte z. Bsp. ein zentrales Dropdown oder ein Pivottable sein, mit deren Werten Du die Zielzelle füllst.

[Bienentreu]

Genau dass mit dem DD-Menü, ich hab "Mo, Di, Mi, Do" gewählt und will "Di" rausnehmen, dass nur noch ">Mo, Mi, Do" da steht!

[Egon12]

Hallo,

"Mo, Di, Mi, Do"  steht dann so in Zelle und als Folge dessen soll Di aus den Dropdown Menü entfernt werden?

Gruß Uwe

---

Oder soll, wenn du erneut Di wählst Di aus der Zelle entfernt werden?

Gruß Uwe

[Egon12]

Hallo,

mit kleiner Einschränkung das rückwärts geleert werden muss, kann man es so machen:

Code:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngA As Range, tmpNeu$, tmpAlt, tmp, tmpA, i&
    On Error GoTo Errorhandling
    If Not Application.Intersect(Target, Range("B4:B14")) Is Nothing Then
          Set rngA = Target.SpecialCells(xlCellTypeAllValidation)
          If rngA Is Nothing Then GoTo Errorhandling
          If Not Application.Intersect(Target, rngA) Is Nothing Then
                Application.EnableEvents = False
                tmpNeu = Target.Value
                Application.Undo
                tmpAlt = Target.Value
               
                Target.Value = tmpNeu
                If tmpAlt <> "" Then
                    If InStr(1, tmpAlt, tmpNeu, vbTextCompare) = 0 Then
                        If tmpNeu <> "" Then
                            Target.Value = tmpAlt & ", " & tmpNeu
                        End If
                    Else
                        tmp = Split(tmpAlt, ", ")
                        For i = LBound(tmp) To UBound(tmp)
                            If Not tmpNeu = tmp(i) Then
                                tmpA = tmpA & tmp(i) & ", "
                            End If
                        Next i
                        If UBound(tmp) > 0 Then
                            Target.Value = Left(tmpA, Len(tmpA) - 2)
                        Else
                            Target = ""
                        End If
                    End If
                End If
          End If
    End If
Errorhandling:
    Application.EnableEvents = True
End Sub

  dropdown mit mehrfachauswahl und zurück.xlsm (Größe: 17,91 KB / Downloads: 2)

Gruß Uwe

[Kuwer]

Hallo Ralf,

teste mal damit:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20240118
    Dim xRng As Range
    Dim xValue1 As String
    Dim xValue2 As String
    Dim delimiter As String
    Dim TargetRange As Range

    Set TargetRange = Me.UsedRange ' Users can change target range here
    delimiter = ", " ' Users can change the delimiter here

    If Target.Count > 1 Or Intersect(Target, TargetRange) Is Nothing Then Exit Sub
    On Error Resume Next
    Set xRng = TargetRange.SpecialCells(xlCellTypeAllValidation)
    If xRng Is Nothing Then Exit Sub
   
    Application.EnableEvents = False
    xValue2 = Target.Value
    Application.Undo
    xValue1 = Target.Value
   
    If Len(xValue2) Then
      If Len(xValue1) Then
        If InStr(1, xValue1, xValue2) Then
          xValue1 = Replace(xValue1, delimiter & xValue2, "")
          xValue1 = Replace(xValue1, xValue2 & delimiter, "")
          xValue1 = Replace(xValue1, xValue2, "")
        Else
          xValue1 = xValue1 & delimiter & xValue2
        End If
      Else
        xValue1 = xValue2
      End If
    End If
    Target.Value = xValue1

    Application.EnableEvents = True
    On Error GoTo 0
End Sub

Gruß, Uwe