Code Umschreiben und Fehlermeldung
01.12.2021 08:11:03
Hannes
ich habe folgenden Code zusammengeschustert, der genau macht, was ich will:
Const TargetColumn As Long = 3 ' Ziele in Spalte 3.
Const bolSorted As Boolean = True ' Legt fest, ob die Werte noch sortiert werden.
Dim blockedEvent As Boolean
Dim TargetOldText As String
Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
'Update 20200430
Static xRow
Static xColumn
If xColumn "" Then
With Columns(xColumn).Interior
.ColorIndex = xlNone
End With
With Rows(xRow).Interior
.ColorIndex = xlNone
End With
End If
pRow = Selection.Row
pColumn = Selection.Column
xRow = pRow
xColumn = pColumn
With Columns(pColumn).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
With Rows(pRow).Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
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 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 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) Nun haben sich 2 Prbleme ergeben:
1. Wie kann ich die Mehrfachauswahl der Drop downs auf weitere Spalten beziehen? Sprich
Const TargetColumn As Long = 3 entsprechend umschreiben
2. Sobald ich neue Drop downs einfüge erhalte ich Laufzeitfehler 13, Typen unverträglich.
und markiert wird die fett gedruckte Zeile: strTarget = Trim(Target.Value)