AW: Vorschlagswert in Dropdown-Feld
28.10.2015 16:54:10
matthias
Hallo Fabian,
eine dynamische Datenüberprüfung in dem Sinne ist mir nicht bekannt. Was aber machbar ist, wäre mittels Ereignis deine Liste zu setzen.
https://www.herber.de/bbs/user/101101.xlsm
Dazu wird zunächst eine Datenliste benötigt in dem für jedes markante Datum dein Vorschlag steht (s. Beispielmappe, Tabelle2).
Änderst du nun in dem im Makro definierten Bereich (hier Tabelle 1 Spalte A) einen Wert bzw. trägst einen neuen ein, wird dir dein Vorschlag hinzugefügt solang dieser in der Datenliste gefunden wird.
Löschst du den Eintrag oder es gibt ihn nicht in der Datenliste wird die Datenüberprüfung entfernt (keine Vorschläge).
Was heist das nun für dich? Du musst deine Datums-Einträge alle nochmal neu schreiben. Keine Sorge, Spalte markieren, kopieren und wieder einfügen reicht vollkommen aus.
Für alle die die Datei nicht laden wollen, hier das Makro zur Einsicht:
Private Sub Worksheet_change(ByVal Target As Range)
Dim rZelle As Range, rFund As Range, rDaten As Range
'Wenn Eingabe in Spalte A
If Not Intersect(Target, Columns("A")) Is Nothing Then
'Liste Vorschläge
Set rDaten = Sheets("Tabelle2").Range("A:A")
For Each rZelle In Intersect(Target, Columns("A")).Cells
If rZelle = "" Then GoTo ValDelete
If rZelle.Row > 0 Then 'Kopfzeilen (hier keine)
Set rFund = rDaten.Find(What:=rZelle, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not rFund Is Nothing Then
With rZelle.Offset(0, 1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=CStr(rFund.Offset(0, 1))
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = False
.ShowError = False
End With
Else
ValDelete:
rZelle.Offset(0, 1).Validation.Delete
End If
End If
Next rZelle
End If
End Sub
lg Matthias