Microsoft Excel

Herbers Excel/VBA-Archiv

Datenüberprüfung flexibel

Betrifft: Datenüberprüfung flexibel von: Erwin
Geschrieben am: 03.11.2014 21:12:23

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

  

Betrifft: AW: Datenüberprüfung flexibel von: Erwin
Geschrieben am: 04.11.2014 12:16:53

Hallo,
gibt es hier gar keine Ideen?
Ich kann mir nicht vorstellen, dass man die Bereiche nicht flexibel gestalten kann.
Grüße - Erwin


  

Betrifft: AW: Datenüberprüfung flexibel von: Daniel
Geschrieben am: 04.11.2014 13:00:33

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


  

Betrifft: AW: Datenüberprüfung flexibel von: Erwin
Geschrieben am: 04.11.2014 14:12:14

Hallo Daniel,
danke für die Mühe, funktioniert schon gut, habe aber jetzt festgestellt, dass ich auch Zellen mit Datenüberprüfung habe, die keine Auswahllisten haben. Es gibt auch
-Zeitbereiche (z. B. Geb.dat. darf nur zw. 01.01.1945 und heute()-5110 liegen) oder
- Wertebereiche (z. B. größer 0).
Ergänzte Datei: https://www.herber.de/bbs/user/93535.xlsm
Diese dürfen dann keine dropdownliste generieren; die Zeile mit der Auswahlliste ist dann leer.
Kann man das noch ändern?
Grüße - Erwin


  

Betrifft: AW: Datenüberprüfung flexibel von: Daniel
Geschrieben am: 05.11.2014 11:53:31

Hi
ja, ist aber keine kleine Änderung mehr, sondern da muss man das dann schon anders programmieren
hab ich jetzt nur keine Zeit für, ausserdem hab ich deine Eingangsfrage ja schon mit einem vollständigen Code beantwortet.
Da darf dann jetzt jemand anderes dran.
Gruß Daniel


  

Betrifft: AW: Datenüberprüfung flexibel von: Erwin
Geschrieben am: 05.11.2014 12:00:50

Hallo Daniel,
da habe ich zu Beginn nicht darüber nachgedacht, wie eine Lösung aussehen könnte.
Trotzdem danke nochmals.
Für die Zukunft werde ich mir merken, dass ich die Tabellen genauer nachbauen muss.
Ich lasse den Beitrag offen.
Grüße - Erwin