Mehfachauswahl in Dropdown-Liste
08.09.2021 10:41:23
Eckard
Hallo zusammen,
ich habe mir eine VBA-Hilfe aus dem Internet gesucht, um eine Mehrfachauswahl in einer Dropdown-Liste zu ermöglichen. Mehrfach ausgewählte Inhalte werden durch Semikolon getrennt nacheinander aufgeführt. Wenn ich jetzt aber beispielsweise die Auswahl optisch anpassen möchte (beispielsweise nummerieren, Zeilenumbruch einfüge etc.) werden alle Inhalte verdoppelt. Leider reichen meine Kenntnisse nicht aus um herauszufinden, ob und wie ich dies verhindern kann. Also ich möchte einfach nur, dass ich mehrere Attribute auswählen und diese dann problemlos nummerieren kann. Ist so etwas möglich? Oder kann der Code so angepasst werden, dass meine Auswahl immer direkt nummeriert und per Zeilenumbruch getrennt wird?
Bsp.
"1) Auswahl a,
2) Auswahl b.
3) Auswahl c,
Hier die Formel (wie gesagt, aus dem Internet kopiert):
Const TargetColumn As Long = 4 ' Ziele in Spalte 4.
Const bolSorted As Boolean = True ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim arrSorted As Variant
Dim i As Long
If Target.Column = TargetColumn Then
strTarget = Trim$(Target.Value)
If Not blockedEvent Then
blockedEvent = True
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(TargetOldText, ", " & strTarget, "")
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & ", " & Target.Value
End If
If bolSorted Then
arrSorted = Split(strResult, ", ")
strResult = ""
Call Selectionsort(arrSorted)
For i = 0 To UBound(arrSorted)
strResult = strResult & arrSorted(i) & ", "
Next i
If Len(strResult) > 1 Then _
strResult = Left$(strResult, Len(strResult) - 2)
End If
Target.Value = strResult
Else
Target.Value = Target.Value
End If
TargetOldText = Target.Value
Else
blockedEvent = False
End If
Else
TargetOldText = ""
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Target.Column = TargetColumn Then
TargetOldText = Target.Value
End If
End Sub
Private Sub Selectionsort(ByRef data As Variant)
Dim OG&, i&, j&, k&, h As Variant
OG = UBound(data)
For i = 0 To OG - 1
h = data(i)
k = i
For j = i + 1 To OG
If data(j)