Beiträge zum Thread: Kann man die Quelle bei Datenüberprüfung anzeigen lassem?

Hi,

lass mal laufen. Tabelle1 ist in meinem Beispiel der Codename für das Blatt, in dem sich die Dropdowns befinden. Das musst Du bei Bedarf anpassen.
Die Ausgabe erfolgt in einem neuen Blatt "Auflistung".

Option Explicit



Sub til()

Dim C As Range, x As Long, Ws As Worksheet

On Error Resume Next

Set Ws = Worksheets("Auflistung")

If Ws Is Nothing Then

    Set Ws = Worksheets.Add

    Ws.Name = "Auflistung"

End If

x = 2

Ws.Cells.ClearContents

Ws.Cells(1, 1) = "Zelle"

Ws.Cells(1, 2) = "Bezug"

For Each C In Tabelle1.Cells.SpecialCells(xlCellTypeAllValidation)

    If C.Validation.InCellDropdown Then

        Ws.Cells(x, 1) = C.Address(0, 0, , True)

        Ws.Cells(x, 2) = "'" & C.Validation.Formula1

        x = x + 1

    End If

Next C

Ws.Columns("A:B").AutoFit

End Sub

VG, Boris

Hallo, danke für deinen Beitrag!
Ich habe das Wort Tabelle1 ausgetauscht mit dem Blattnamen August bei mir. Aber irgendwie passiert nichts....

Liebe Grüße Dirk

Hi,

wenn Du den Blattnamen "August" verwenden möchtest, dann ersetze 'Tabelle1' durch

Worksheets("August")

VG, Boris

Danke Dir!

Wenn es Dir nichts ausmacht, ich schick dir mal meine Datei! Vielleicht kannst Du es ja mal in den Monat oder für den Monat einpflegen, so dass es funktioniert!
Mit VBA habe ich wenig Erfahrung!

https://www.herber.de/bbs/user/180773.xlsm


Liebe Grüße Dirk

Hi,

ist doch alles ok. Gehe in den VBA-Editor, dann wähle das Blatt "August" aus, setzte den Cursor rechts irgendwo mitten in das Makro und drücke F5. Schließe den Editor und sieht Dir das Ergebnis im Blatt "Auflistung" an.

VG, Boris

Hi,

hab den Code mal erweitert auf alle Blätter (bzw. auf alle Blätter mit Monatsnamen).
Wenn weitere Monate dazukommen, dann muss Du das Array entsprechend erweitern.

Um es sauber zu machen:

Füge den Code in ein ALLGEMEINES Modul ein (Einfügen - Modul).
Dann starte ihn mit F5.

Option Explicit



Sub til()

Dim c As Range, x As Long, Ws As Worksheet, Ws2 As Worksheet

On Error Resume Next

Set Ws = Worksheets("Auflistung")

If Ws Is Nothing Then

    Set Ws = Worksheets.Add

    Ws.Name = "Auflistung"

End If

x = 2

Ws.Cells.ClearContents

Ws.Cells(1, 1) = "Zelle"

Ws.Cells(1, 2) = "Bezug"

With Application

    .Calculation = xlCalculationManual

    .ScreenUpdating = False

    For Each Ws2 In Worksheets(Array("Januar", "Februar", "März", "April", "Mai", "Juni", "Juli", "August"))

        For Each c In Ws2.Cells.SpecialCells(xlCellTypeAllValidation)

            If c.Validation.InCellDropdown Then

                Ws.Cells(x, 1) = c.Address(0, 0, , True)

                Ws.Cells(x, 2) = "'" & c.Validation.Formula1

                x = x + 1

            End If

        Next c

    Next Ws2

    .Calculation = xlCalculationAutomatic

    .ScreenUpdating = True

End With

Ws.Columns("A:B").AutoFit

End Sub

VG, Boris

Ah Ok Vielen Dank!

Funktioniert gut!


Weisst Du auch zufälliger Weise, ob man auch nur einzelne Zellen vor "Kopieren und Einfügen" schützen kann!?
Meine Kollegen machen es sich sehr einfach und kopieren nur immer, aber zerstören dadurch manche programmierte Zellen!

Danke nochmal!

Dirk

Hi,

...ist der KILL für jede Datei, die - wie in Deinem Fall - Auswahlmöglichkeiten zur Verfügung stellt.
Drohe den Kollegen Todessstrafe an, wenn sie das weiter machen - oder sag ihnen, dass Du die Datei dann mit einer externen (Programmierer-)bezahlung wasserdicht machen musst - und stell ihnen die Kosten (sicher ca. € 1.000,-) in Rechnung.

VG, Boris

Hallo


Das ginge z.B. mit einer VBA Funktion

in ein Modul:

Function DVQuelle(c As Range) As String

    On Error GoTo Ende

    DVQuelle = c.Validation.Formula1

    Exit Function

Ende:

    DVQuelle = ""

End Function

Im Blatt dann so

Arbeitsblatt mit dem Namen 'Tabelle1'   A B C D E F G H I J 1               Liste1 Liste2   2 1007   =$H$2:$H$12         1001 2001   3               1002 2002   4               1003 2003   5 2005   =$I$2:$I$8         1004 2004   6               1005 2005   7               1006 2006   8               1007 2007   9               1008     10               1009     11               1010     12               1011     13                     14                     15                     16

Zelle Formel C2 =DVQuelle(A2)

Zelle Gültigkeitstyp Operator Wert1 Wert2 A2 Liste   =$H$2:$H$12   A5 Liste   =$I$2:$I$8

LG UweD

Vielen Dank Uwe für Deine schnelle Hilfe.
Muss ich da noch etwas einsetzen oder Variablen ergänzen!?

Irgendwie passiert da nicht viel, wenn ich das bei Code einfüge...!?

Liebe Grüße Dirk

Hi

Wie geschrieben in ein Modul reinkopieren

- ALT + F11 öffnet den VBA Editor
- Einfügen Modul
- rechts dann den Code reinkopieren
- VBA Editor kannst du wieder schließen


- In deinem Tabellenblatt dann in der gewünschten Zelle die Formel =DVQuelle(A2) eintragen
anstelle A2 DEINE Zelle wählen


LG UweD