DropDown-Mehrfachauswahl in mehreren Spalten
22.05.2019 12:47:33
HaLo_94
ich arbeite an einer Projektplanung und möchte in zwei Spalten entsprechende Personen so auswählen können, dass auch mehrere Personen in einer Zelle aufgelistet werden können (getrennt durch "+") und diese auch alphabetisch sortiert werden. Außerdem soll die Auswahl der Person(en), die man getroffen hat, auch wieder gelöscht werden können, indem man die Person(en) in der DropDown-Auswahl erneut anklickt und somit verschwinden. Dies funktioniert bisher mit folgendem Code:
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 = 13 Or Target.Column = 14 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) allerdings nur insofern, dass es lediglich in der ersten Spalte einwandfrei funktioniert. Wenn ich aber nun in der nächsten Spalte eine Mehrfachauswahl treffe, dann wird der Inhalt der vorherigen Auswahl aus der ersten Zelle mit übernommen, obwohl die Datenüberprüfung auf verschiedene Listen zugreift.
Beispiel: In Spalte A möchte ich Fr. Meier und Hr. Schulze auswählen. Klappt ganz gut, denn nun steht bei mir in Zelle A1 "Fr. Meier + Hr. Schulze". Gehe ich allerdings zur Spalte B, wo ich lediglich "Hr. Müller" auswählen möchte, steht plötzlich "Fr. Meier + Hr. Müller + Hr. Schulze" in der Zelle, sobald ich Hr. Müller angeklickt habe. Excel "merkt" sich sozusagen die Auswahl aus der vorherigen Spalte/Zelle.
Abgesehen von dieser Schwierigkeit gibt es noch das Problem, dass die Abstände zwischen den Zeichen/Buchstaben und den Trennzeichen ("+") nach dem Auswählen unregelmäßig sind und ich es mir nicht erklären kann wieso?! Aber das nur nebenbei - die Lösung für das zuvor beschriebene Problem hat höhere Priorität.
Leider stehen meine Kenntnisse in VBA noch am Anfang und ich hoffe, dass mir jemand in meinem laienhaften Dasein zu Seite stehen kann :-)
Ein Upload der entsprechenden Excel-Datei ist leider nicht möglich und ich hoffe, dass der oben gepostete Code zur Fehleranalyse bzw. Hilfestellung ausreicht.
Viele und liebe Grüße
HaLo