Thomas Risi Softwareentwicklung
Addins - Datenbanklösungen - Komponenten - RTDServer - WebServices
Mehrfachauswahl aus Gültigkeitsliste (2)
Downloads Demo-Datei
Aus einer Frage in einem Forum ...
In Spalte C einer Tabelle, gibt es mehrere Zellen die eine Liste als Gültigkeitskriterium enthalten. Es soll nun möglich sein, mehrere dieser
Werte in der jeweiligen Zelle, durch ein Komma getrennt, darzustellen.
Hier ist es auch möglich, eingefügte Werte durch nochmaliges Anklicken wieder zu löschen. Und sogar Sortieren kann man ...
Quellcode für z.B. Tabelle1 ...
Option Explicit
Const TargetColumn As Long = 3
Const bolSorted As Boolean = True
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, ", " & 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
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) < h Then
h = data(j)
k = j
End If
Next j
data(k) = data(i)
data(i) = h
Next i
End Sub
© 2001 -
by Thomas Risi