Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 08:59:38
Bedingte Formatierung
23.04.2024 08:56:21
Mehrzeilige Zellen in einzelne Zeilen aufteilen & auswer
23.04.2024 08:26:15
Rückgabewert mehrere Suchkriterien Datumsbereich
23.04.2024 08:20:37
VBA: Blatt als pdf per Mail. Blatt mit anderen pdfs vereinen
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1860to1864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1860to1864
1860to1864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Mehrfachauswahl drop down

Mehrfachauswahl drop down
14.12.2021 16:21:23
Hannes
Hallo,
dank Yal bin ich im folgenden Thread schon weit voran gekommen:
https://www.herber.de/forum/cgi-bin/callthread.pl?index=1860224
Leider stecke ich in der Umsetzung beim letzten Schritt fest:
Mein mangelndes Verständnis reicht nur für diese Umformulierung aus:
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.Cells.Count > 1 Then Exit Sub
If Target.Column  0 Then
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 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


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)
Leider funktioniert so nichts mehr.
Danke für die Hilfe!
Gruß Hannes

13
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Mehrfachauswahl drop down
14.12.2021 18:43:51
Yal
Hallo Hannes,
warum gibt es jetzt zwei Variablen "OldTarget" und "TargetOldText"?
Hast Du etwa altes und und neues Coding vermischt?
Es gab, so weit ich mich erinnern kann, auch andere Variante davon.
Die Variable-Deklaration ("Dim") müssen immer ganz oben sein, und keinesfalls zwischen zwei Subs stattfinden.
Unter "Extras", "Optionen", "Editor" setzt "Variable erforderlich" an (MUSS! Die Peitsche gehört zu Lernvorgang dazu)
Ich würde übrigens die Sortierungs-Sub in eine Function umwandeln, die eine Komma-getrennte Zeichenkette annimmt und ein Komma-getrennte Zeichenkette zurückgibt.
Dann spart man viele Gewusel im Hauptstrang.
Die -von irgendwo herkommende "If ... 6lt;=105 " ist nutzlos, da anschliessend geprüft wrid, ob es sich um die Zelle C1 handelt. Diese Zelle befindet sich bekanntermassen in einer Spalte vor der 105. Spalte.
Warum geht man über eine Konstante, die immer True ist, um dann diese zu testen und nur zu sortieren, wenn sie True ist. Da Du nicht viele Einträge hast, ist die Sortierung immer schnell erledigt. Also immer sortieren.
Coding sieht dann so: Die 2 Subs und die Variable-Deklaration davor gehören zusammen. Die Function "SelectionSort" passt auch zu der Aufruf in Worksheet_Change und ist nicht mit einer Vorversion austauschbar.

Dim OldTarget As Range 'Gedächnisvariable
Dim TargetOldText As String
Dim blockedEvent As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, OldTarget, Range("C1")) Is Nothing Then
strTarget = Trim(Target.Column)
If Not blockedEvent Then
blockedEvent = True
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & ", " & Target.Value
End If
Target.Value = SelectionSort(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
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
TargetOldText = Target.Value
End Sub
Private Function SelectionSort(ByVal Eingang As String, Optional TrennZeichen = ", ") As String
Dim Data, OG&, i&, j&, k&, h As Variant
Data = Split(Eingang, TrennZeichen)
OG = UBound(Data)
For i = 0 To OG - 1
h = Trim(Data(i))
k = i
For j = i + 1 To OG
If Data(j)
VG
Yal
Anzeige
AW: Mehrfachauswahl drop down
15.12.2021 08:31:34
Hannes
Hallo,
Ja perfekt es funktioniert. Nach einer Anpassung im selectionChange (wie in vorigem Thread beschrieben) klappt das mit den Spalten einfügen.
Die Range habe ich von C1:auf C500 erweitert, damit ich den Code auf mehrere Zellen in der Spalte anwenden kann....es klappt nicht wenn ich C:C eingebe(dann verschiebt sich der Code nicht mit den Spalten mit)...ich vermute das hängt mit der Gedächtnisvariable zusammen?
Eine Frage habe ich dann noch, wie kann ich eine 2. Spalte z.B. Spalte E mit in dem Code einbauen?
Mit schreibweisen wie: Range("C1:C500") Or Range("E1:E500") oder Range ("C1:C500;E1:E500")
klappt es leider nicht...
Mein Code ist entsprechend wie folgt:
Dim OldTarget As Range 'Gedächnisvariable
Dim TargetOldText As String
Dim blockedEvent As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, OldTarget, Range("C1:C500")) Is Nothing Then
strTarget = Trim(Target.Column)
If Not blockedEvent Then
blockedEvent = True
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & ", " & Target.Value
End If
Target.Value = SelectionSort(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


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
On Error GoTo Finally
If Target.Cells.Count = 1 Then TargetOldText = Target.Value
Finally:
End Sub


Private Function SelectionSort(ByVal Eingang As String, Optional TrennZeichen = ", ") As String
Dim Data, OG&, i&, j&, k&, h As Variant
Data = Split(Eingang, TrennZeichen)
OG = UBound(Data)
For i = 0 To OG - 1
h = Trim(Data(i))
k = i
For j = i + 1 To OG
If Data(j)
Vielen Dank für die Hilfe!
Anzeige
AW: Mehrfachauswahl drop down
15.12.2021 10:40:57
Yal
Hallo Hannes,
ja, es liegt an "der Sprache der Computer", die dazu führt, dass man nicht "wenn a gleich b oder c" mit a = (b or c) sondern mit (a = b ) or (a = c) kodieren muss.
Dementsprechend:

If Not Intersect(Target, OldTarget, Range("C1:C500")) Is Nothing  _
And Not Intersect(Target, OldTarget, Range("E1:E500")) Is Nothing Then
VG
Yal
AW: Mehrfachauswahl drop down
15.12.2021 15:18:11
Hannes
Hallo,
ich bin verwirrt.... mein Code aus voriger nachricht (C1:C500) klappt nach umschreiben, allerdings nach schließen und öffnen nicht mehr......erst wenn ich die Range wieder auf C1 stelle und draufhin wieder auf C1:C500. Woran kann das denn bitte liegen?
Zu dem anderem Problem... Wenn ich spalte E wie folgt einfüge arbeitet der Code nicht:
Dim OldTarget As Range 'Gedächnisvariable
Dim TargetOldText As String
Dim blockedEvent As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim i As Long
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, OldTarget, Range("C1")) Is Nothing _
And Not Intersect(Target, OldTarget, Range("E1")) Is Nothing Then
strTarget = Trim(Target.Column)
If Not blockedEvent Then
blockedEvent = True
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & ", " & Target.Value
End If
Target.Value = SelectionSort(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


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 _
And Not Intersect(Target, OldTarget, Range("E:E")) 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
On Error GoTo Finally
If Target.Cells.Count = 1 Then TargetOldText = Target.Value
Finally:
End Sub


Private Function SelectionSort(ByVal Eingang As String, Optional TrennZeichen = ", ") As String
Dim Data, OG&, i&, j&, k&, h As Variant
Data = Split(Eingang, TrennZeichen)
OG = UBound(Data)
For i = 0 To OG - 1
h = Trim(Data(i))
k = i
For j = i + 1 To OG
If Data(j)

Anzeige
AW: Mehrfachauswahl drop down
15.12.2021 18:26:20
Yal
Hallo Hannes,
Wenn Du keine spezielle Verarbeitung in SelectionChange hast, brauchst Du dort keine spezielle Behandlung.
Ich habe übersehen, dass dort auch ein Intersect gibt. Diese bringt aber nichts.
Neuer Code (SelectionSort bleicbt unverändert). Such-Spiel: wo sind die Änderung versteckt?

Option Explicit
Dim OldTarget As Range 'Gedächnisvariable
Dim blockedEvent As Boolean
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set OldTarget = Target
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim strResult As String
Dim strTarget As String
Dim OldText As String
Application.EnableEvents = False
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, OldTarget, Range("C1:C500")) Is Nothing _
Or Not Intersect(Target, OldTarget, Range("E1:E500")) Is Nothing Then
strTarget = Trim(Target.Column)
OldText = OldTarget.Range("A1").Value
If Not blockedEvent Then
blockedEvent = True
If Not OldText = "" And Not Target.Value = "" Then
If InStr(1, OldText, Target.Value) > 0 Then
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = OldText & ", " & Target.Value
End If
Target.Value = SelectionSort(strResult)
Else
Target.Value = Target.Value
End If
If Target.Cells.Count = 1 Then OldText = Target.Value
Else
blockedEvent = False
End If
Else
OldText = ""
End If
Application.EnableEvents = True
End Sub
VG
Yal
Anzeige
AW: Mehrfachauswahl drop down
15.12.2021 18:27:53
Yal 

strTarget = Trim(Target.Column)
Sollte es nicht eher 

strTarget = Trim(Target.Value)
sein?
AW: Mehrfachauswahl drop down
16.12.2021 13:41:52
Hannes
Hi,
bei deinem neuen Code klappt aber die Auflistung nicht mehr.
Wenn ich dort einen Eingabe Tätige und sie dann Überscheiben will, wird der gesamte Inhalt gelöscht.
Danke für deine Hilfe!
AW: Mehrfachauswahl drop down
16.12.2021 14:13:56
Yal
Hallo Hannes,
ich habe es bisher vermieden, von Dir eine Datei zu verlangen, aber ich fürchte, dass es ohne nicht vorankommen wird.
Darüber hinaus ist es fraglich, ob Dir den Stress antun möchte, einen Code anzuwenden, den Du nicht selber überschaust oder pflegen kannst. Bei jeder kleinsten Änderungen besteht das Risiko, dass irgendwas nicht mehr funktioniert.
VG
Yal
Anzeige
AW: Mehrfachauswahl drop down
16.12.2021 18:20:38
Yal
Kannst Du mir bei der Gelegenheit erinnern, was diese "tut was es soll" nochmal war?
Soweit ich mich erinnern kann, gibt es Zellen mit Drop down. Wenn ein zweite auswahl aus dem Drop Down dazu kommt, sollte das neue sich anreihen. Wenn schon vorhanden, dann aus der Liste wieder entfernt werden, richtig?
AW: Mehrfachauswahl drop down
16.12.2021 21:51:32
Yal
Hallo Hannes,
ich hatte hingewiesen, dass irgendwo einen Target.Column womöglich falsch wäre. Es war aber nicht das einzige Problem.
Folgendem Code funktioniert nur für Einträge als ZAHL von 0 bis 499 (also 500 - 1). Für mehr den 500 in AddOrRemove anpassen.

Dim OldTarget As Range 'Gedächnisvariable
Dim OldText As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set OldTarget = Target
OldText = OldTarget.Range("A1").Value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim IstInC
Dim IstInE
Application.EnableEvents = False ' 1 Then Exit Sub
If OldTarget Is Nothing Then Exit Sub
Set IstInC = Intersect(Target, OldTarget, Range("C1:C500"))
Set IstInE = Intersect(Target, OldTarget, Range("E1:E500"))
If Not ((IstInC Is Nothing) And (IstInE Is Nothing)) Then
Target = AddOrRemove(OldText & ", " & Trim(Target.Value))
OldText = Target.Value
End If
Application.EnableEvents = True
End Sub
Private Function AddOrRemove(ByVal Eingang, Optional TrennZeichen = ", ") As String
Dim Arr(500) As Integer
Dim E, msg, i
On Error Resume Next
'Sammeln (leere werden ignoriert)
For Each E In Split(Eingang, TrennZeichen)
Arr(E) = Arr(E) + 1
Next
'Verketten
For i = 0 To UBound(Arr)
If Arr(i) = 1 Then msg = msg & TrennZeichen & i
Next
'Herausgeben
AddOrRemove = Mid(msg, Len(TrennZeichen) + 1)
End Function
VG
Yal
Anzeige
AW: Mehrfachauswahl drop down
17.12.2021 07:43:19
Hannes
Hallo Yal,
ja, die Funktion ("Tut was es soll") ist wunderbar :)
Das einzige was jetzt noch fehlt, ist die funktion, dass sich die funktion beim Einfügen/entfernen von Spalten mitverschiebt. Sprich wenn ich vor Spalte C eine Neue einfüge, soll die funktion dann in D anwendbar sein.
AW: Mehrfachauswahl drop down
17.12.2021 09:35:52
Yal
Hallo Hannes,
ja, in "Worksheet_Change" wird geprüft, ob die Zelle, wo der Wert geändert wurde ("Target") im Bereich "C:C" ode "E:E" liegt. Die Adresse diese Bereich ist fest einkodiert und bekommt von einem Verschiebung nichts mit.
Möchtest Du eine Dynamik haben, muss Du diese Bereich einen Namen geben (Benannte Bereich, in dem Fall eins für C eins für E), zum Beispiel "AuswahlSpalte_C" und "AuswahlSpalte_E" und dann im Coding wie folgt prüfen:

Set IstInC = Intersect(Target, OldTarget, Range("AuswahlSpalte_C"))
Set IstInE = Intersect(Target, OldTarget, Range("AuswahlSpalte_E"))
Ein Fehler habe ich noch entdeckt: OldText ist string und erwartet eine String. Es muss einen "CStr( .." vor der "OldTarget. .." stehen:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set OldTarget = Target
OldText = CStr(OldTarget.Range("A1").Value)
End Sub
VG
Yal
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige