Datenüberprüfung flexibel

Guten Abend,
in einer bestehenden, umfangreichen Datei habe ich festgestellt, dass in mehreren Spalten die Auswahllisten "verschwunden" sind und nur noch Werte in den Zellen stehen.
Möglicherweise ein Effekt, dass nicht alles geschützt werden kann, die Datei im Netz steht und viele User darauf zugreifen können.
Ich möchte das Tabellenblatt "Personen" wiederherstellen; und das Dropdown wieder "unterschieben".
In beiliegender Datei https://www.herber.de/bbs/user/93524.xlsm habe ich das mal per Macrorecorder aufgezeichnet. Leider geht das nicht richtig und bei
.ErrorTitle und
.ErrorMessage
erscheinen nur die fixen Texte.
Ich würde gerne einen Verweis auf den Tabellenreiter "System" z. B. auf den Zellbereich C13:C27 einbinden, damit, wenn sich der Zellinhalt mal verändern sollte, das Makro nicht angepasst werden muss.
Geht das irgendwie?
Wer kann mir bitte helfen?
Danke schon mal
Erwin

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi
probier mal folgenden Code:

Sub AusWahllisten_einrichten()
Dim ze1 As Long
Dim zeAwL As Long
Dim zeFmT As Long
Dim i As Long
Dim DatenÜberprüfungDaten
Dim Zelle As Range
Dim Bereich As Range
With Sheets("System")
ze1 = .Columns(1).Find(what:="Fehlermeldung").Row
zeAwL = .Columns(1).Find(what:="Auswahlliste").Row
zeFmT = .Columns(1).Find(what:="Fehlermeldung Text").Row
ReDim DatenÜberprüfungDaten(1 To WorksheetFunction.CountA(.Rows(ze1)) - 1, 1 To 3)
For Each Zelle In .Rows(ze1).SpecialCells(xlCellTypeConstants, 2)
If Zelle.Column > 1 Then
i = i + 1
DatenÜberprüfungDaten(i, 1) = Zelle.Value
DatenÜberprüfungDaten(i, 2) = "='" & .Name & "'!" & _
.Cells(zeAwL, Zelle.Column).CurrentRegion.Address
DatenÜberprüfungDaten(i, 3) = .Cells(zeFmT, Zelle.Column).Value
End If
Next
End With
With Sheets("Personen")
For i = 1 To UBound(DatenÜberprüfungDaten, 1)
Set Zelle = .Cells.Find(what:=DatenÜberprüfungDaten(i, 1), lookat:=xlWhole)
If Not Zelle Is Nothing Then
Set Bereich = Range(Zelle.Offset(1, 0), Intersect(Zelle.EntireColumn, _
.Cells.SpecialCells(xlCellTypeLastCell).EntireRow))
With Bereich.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=DatenÜberprüfungDaten(i, 2)
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = DatenÜberprüfungDaten(i, 1)
.InputMessage = ""
.ErrorMessage = DatenÜberprüfungDaten(i, 3)
.ShowInput = True
.ShowError = True
End With
End If
Next
End With
End Sub

damit der Code funktionert muss dein Blatt "System" so aufgebaut sein wie im Beispiel gezeigt.
In Spalte A zeigen die Beschriftungen an, wo die einzelnen Infoblöcke (Überschrift, zulässtige Daten, Meldungstext) stehen (nach den gezeigten Texten wird gesucht)
die einzelnen Blöcke müssen jeweils durch mindestens eine Leerzeile und Leerspalte voneinander getrennt sein.
einzige Änderung die du machen musst: die Werte der Auswahlliste (Berlin, London,...) müssen in der gleichen Zeile beginnen in der der Text "Auswahlliste" steht (also 1 nach oben gerutscht)
Wenn du einen Text in der Auswahlliste änderst, braucht das Makro nicht neu gestartet zu werden, das wird automatisch übernommen.
Fügst du jedoch einen Text inzu, musst du as Makro nochmal starten.
Gruß Daniel

Beliebteste Forumthreads (12 Monate)

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread