Erweiterung des Makros
29.09.2021 04:22:12
Sven
Bei der Erstellung hat ein nicht mehr verfügbarer Kollege geholfen. Ich versuche noch, mich mit VBA anzufreunden, aber es geht nicht.
Folgendes Makro soll in Spalte 17 und Spalte 18 ausgeführt werden:
Option Explicit
Const TargetColumn As Long = 17 ' Ziele in Spalte 17 (Q).
Const bolSorted As Boolean = False ' 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 = 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, 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 With
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, 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
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)