- Startseite
- Neuigkeiten
- Über mich
- Referenzen
- Beispiele
- Artikel
- Tools
- Access-Tipps
- Excel-Tipps
- Excel-UDF
- UDF-Hilfe
- Ausrechnen()
- EANCode()
- Mehrfachauswahl
- Spaltenbuchstabe()
- Verbinden()
- Spielereien
- Kontakt
- Impressum
- Datenschutz
Meine Projekte:


Gültigkeitsprüfung mit Mehrfachauswahl
Mit dieser Tabellenblatt-Funktion kann man in Excel in Gültigkeitslisten mehrere Werte auswählen und auch wieder entfernen.
Anforderung:
In einer Excelliste sollen nur bestimmte Werte eingeben werden dürfen. Dies ist bereits per Datenüberprüfung mit einer Gültigkeitsliste gelöst. In einzelnen Feldern sollen jetzt aber mehrere Werte ausgewählt werden können.
Lösung:
Es gibt von Excel-Inside Solutions bereits eine Lösung , die den Nachteil hat (oder die Möglichkeit bietet), einen Wert mehrfach einzufügen. Ich habe diese Lösung so erweitert, dass jetzt ein einmal ausgewählter Wert bei erneuter Auswahl wieder aus der Liste entfernt wird.

So sieht die fertige Funktion aus:
Private Sub Worksheet_Change(ByVal Target As Range) '================================================================================== ' Eine Tabellenblatt-Funktion aus Raphael Heins Da|ten|bank|Ma|nu|fak|tur ' ' Benutzung: Funktion in jedes Blatt in dem die Funktion benötigt wird kopieren ' und den Bereich anpassen ' Funktion: Mehrfachauswahl über DropDown-Liste (Datenüberprüfung) ermöglichen ' Besonderheit: Bereits ausgewählte werte werden wieder entfernt ' ' Autoren: Alois Eckl, Raphael Hein ' Datum: 14.06.2016 '================================================================================== Dim rngDdf As Range ' Range mit Dropdown-Feldern Dim strOld As String ' Neuer Wert Dim strNew As String ' Alter Wert On Error GoTo Errorhandling ' Bereich oder Zellen mit Mehrfachauswahl festlegen (z. B. auch "C6,C8:10") If Not Application.Intersect(Target, Range("C6")) Is Nothing Then '<== Anpassen ' Nur Zellen mit Gültigkeitsprüfung bearbeiten Set rngDdf = Target.SpecialCells(xlCellTypeAllValidation) If rngDdf Is Nothing Then GoTo Errorhandling ' Prüfen, ob eine gültige Zelle ausgewählt wurde If Not Application.Intersect(Target, rngDdf) Is Nothing Then Application.EnableEvents = False strNew = Target.Value Application.Undo strOld = Target.Value ' Ist der neue Wert bereits in der Zelle enthalten If InStr(strOld, strNew) > 0 Then ' Dann wieder rauslöschen Select Case True ' Wert steht an erster Stelle oder mittendrin Case InStr(strOld, strNew & ", ") > 0 strNew = Replace(strOld, strNew & ", ", "") ' Wert steht am Ende Case InStr(strOld, ", " & strNew) > 0 strNew = Replace(strOld, ", " & strNew, "") ' Wert steht als einziger in der Liste Case InStr(strOld, strNew) > 0 strNew = Replace(strOld, strNew, "") End Select Target.Value = strNew Else ' sonst hinten anhängen Target.Value = strNew If strOld <> "" Then If strNew <> "" Then Target.Value = strOld & ", " & strNew End If End If End If End If Application.EnableEvents = True End If Errorhandling: Application.EnableEvents = True End Sub
Diese Funktion arbeitet natürlich auch in Excel:mac.
Download
Gültigkeitsprüfung mit Mehrfachauswahl für Excel 2007 (und neuer)
(Datei: Mehrfachauswahl.zip, ca. 17 KB)