Mehrfachauswahl drop down

Hallo zusammen,
hier eine Beispieldatei zu meinem Problem:
https://www.herber.de/bbs/user/149609.xlsm
Wenn ich in Spalte 1 nun die Auswahl 1 treffe und daraufhin die Auswahl 2, wird es wie gewünscht in einer Zelle mit kommatrennung angezeigt.
Wenn ich nun eine Zelle tiefer gehe und 3 auswähle erhalte ich 1, 2, 3. Bei Sprung in eine neue Zelle soll allerdings nicht der Wert aus der davorriegen übertragen werden. Gleiches passiert auch bei sprung in eine Zelle einer anderen Spalte.
Kann mir da jemand den Code entsprechend umschreiben, dass ich bei Eingabe in eine neue Zelle nicht die Einträge der davorriegen erhalte?
Mein Code ist wie folgt:
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 = 1 Or Target.Column = 2 Or Target.Column = 3 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
[TargetZeile] = Target.Row
[TargetSpalte] = Target.Column
[TargetValue] = Target.Value
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)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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 = 1 Or Target.Column = 2 Or Target.Column = 3 Then strTarget = Trim(Target.Value) If Not Exit Sub 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 If Target.Cells.Count = 1 Then TargetOldText = Target.Value Else blockedEvent = False End If Else TargetOldText = "" End If End Sub

Hallo Hannes,
mein Tipp: gehe den Code in deutsche Sprache durch:
Wenn das zutrifft,
dann mache dies
sonst mache das
Dabei wird oder sollte Dir die Unterschied zwischen eine Prüfung (was daraus nur richtig oder falsch sein kann) und eine Anweisung (machen) auffallen.
Wenn ich schreibe
If ... Then Exit Sub
lasse es so lesen:
wenn ... (also hier irgendwas, was geprüft wird)
dann Exit Sub (gehe raus aus dem Sub)
Dann ist Exit Sub eine Anweisung. Zwar liefern manche Anweisungen auch gleichzeitig einen Ergebnis, dass in True/False mündet, aber selten. Daher kannst Du den Befehl ("gehe raus aus dem Sub") nicht als eine Prüfung verwenden: es würde wahrscheinlich bedeuten, dass "geh raus" erfolgreich war. Dann wäre jegliche weitere Anweisung nutzlos. Man müsste nicht mal testen, ob erfolgreich oder nicht.
Mit ein Bischen Erinnerungsvermögen hat man noch den Worksheet_SelectionChange im Blick (worauf ich hingewiesen habe):


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count = 1 Then TargetOldText = Target.Value
End Sub

Dann liest man das auf Deutsch:
Wenn die Anzahl an Zellen des übergegebenen Target genau eins (nur eine Zelle wurde übergeben) ist,
Dann nehme in die Variable "TargetOldText" den Wert von der Zelle, die durch "Target" definiert wurde, auf.
Programmieren ist nur Logik und logische Reihenfolge und Übung und Übung und Übung.
Naja, vielleicht doch ein Bischen Denken und Konzentrieren, aber das braucht man auch beim Socken anziehen.
Lernen ist wiederum Willen.
VG
Yal

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.Cells.Count > 1 Then Exit Sub If Target.Column 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 If Target.Cells.Count = 1 Then TargetOldText = Target.Value Else blockedEvent = False End If Else TargetOldText = "" End If End Sub

Dim OldTarget As Range 'Gedächnisvariable Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Test: wo waren wir If Not OldTarget Is Nothing Then If Not Intersect(OldTarget, Range("C:C")) Is Nothing Then '... hier tut sich was End If End If 'Gedächnis setzen: da wo wir jetzt sind, aber bei nächsten Aufruf nicht mehr werden. Set OldTarget = Target End Sub

Beliebteste Forumthreads (12 Monate)

21 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

21
Beiträge zum Forumthread

Beiträge zu diesem Forumthread