Beschränkung auf Spalte

Hallo,
ich habe ein Marko, bei welchem bei in einer Dropdown- Auswahl mehrere Einträge möglich sind und diese untereinander geschrieben werden sollen. Hatte dazu bereits hier gepostet.
Nachdem ich nun selbst gesucht und probiert habe, bin ich soweit vorangeschritten, dass die Einträge in 2 Spalten möglich sind, das Makro arbeitet nur in den gewünschten Spalten.
Leider kopiert der Code die Einträge aus Spalte 17 auch in die Spalte 18, was nicht gewünscht ist.
Ich möchte den Text aus Spalte 17 NUR in Spalte 17, genauso für Spalte 18, also "Replace(TargetOldText...)" soll auf die jeweilige Spalte beschränkt werden.
Genutzt wird folgender Code (auszugsweise):
If Not TargetOldText = "" And Not Target.Value = "" Then
If InStr(1, TargetOldText, Target.Value) > 0 Then
strResult = Replace(TargetOldText, Chr(10) & strTarget, "")
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & Chr(10) & Target.Value 'Chr bedeutet die Auflistung untereinander
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
Und hier hört mein Verständnis auf. Die Recherche im internet hat mehrere, nicht mehr verfügbare (weil gelöschte Tabellen) Lösungen ergeben, daher weiß ich, dass es möglich ist...
Ich hoffe, die Problemstellung ausreichend erklärt zu haben.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hier das vollständige Makro:
Option Explicit
Const bolSorted As Boolean = False ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String
<pre>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 = 17 Or Target.Column = 18 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, Chr(10) & strTarget, "")
strResult = Replace(strResult, strTarget & ", ", "")
strResult = Replace(strResult, strTarget, "")
Else
strResult = TargetOldText & Chr(10) & Target.Value 'Chr bedeutet die Auflistung untereinander
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</pre>
<pre>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) < h Then
h = data(j)
k = j
End If
Next j
data(k) = data(i)
data(i) = h
Next i
End Sub</pre>
Zusätzlich konnte ich jetzt die Tabelle als Beispiel anfügen. https://www.herber.de/bbs/user/148967.xlsm

Dim blockedEvent As Boolean Dim TargetOldText(17 To 18) 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 = 17 Or Target.Column = 18 Then strTarget = Trim$(Target.Value) If Not blockedEvent Then blockedEvent = True If Not TargetOldText(Target.Column) = "" And Not Target.Value = "" Then If InStr(1, TargetOldText(Target.Column), Target.Value) > 0 Then strResult = Replace(TargetOldText(Target.Column), Chr(10) & strTarget, "") strResult = Replace(strResult, strTarget & ", ", "") strResult = Replace(strResult, strTarget, "") Else strResult = TargetOldText(Target.Column) & Chr(10) & Target.Value 'Chr bedeutet die Auflistung untereinander End If Target.Value = strResult Else Target.Value = Target.Value End If TargetOldText(Target.Column) = Target.Value Else blockedEvent = False End If Else TargetOldText(Target.Column) = "" End If End Sub

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread