Listenfeld in Arbeitsmappe

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Du bist im falschen Forum. Bildbearbeitung ist ein anderes.
Bilder lade ich mir nicht runter, da Excel damit nichts anfangen kann.
Hochgeladene Bilder können zwar als solche in Excel importiert werden, sind jedoch bei der Lösung von Problemen nicht sehr hilfreich, da man die eigentlichen Daten nicht ohne große und zeitraubende Umwege direkt in die Tabelle übertragen kann.
Ich baue keine Datei nach, die Zeit hat schon jemand investiert.
Schau mal hier
Eine hochgeladene Arbeitsmappe erhöht die Wahrscheinlichkeit, dass Du eine Lösung für Dein Problem erhältst.
Erstelle folglich bitte eine Demomappe, aus der deine Aufgabenstellung klar erkennbar ist und lade diese hoch.
Wenn du an Stelle einer Demomappe deine Originalmappe hochladen willst, diese aber sensible Daten enthält, kannst du diese Daten ändern. Schaue Datei
http://hajo-excel.de/gepackt/fremd/Datei_verschluesseln.zip
Falls Du den Download des Forums nicht benutzen möchtest, beachte bitte: von unsicheren Servern file-upload lade ich keine Datei herunter (lt. Einschätzung meines Virenprogramms)
Das ist nur meine Meinung zu dem Thema.
Grußformel

Hallo Udo,
in Das Modul "DieseArbeitsmappe":


Option Explicit
Private Sub Workbook_Open()
Call Worksheets("Tabelle1").FillDictionary ' Tabellenname anpassen
End Sub

In das Modul der Tabelle:


Option Explicit
Private mobjDictionary As Object
Private Sub Worksheet_Change(ByVal Target As Range)
Dim objRange As Range, objCell As Range
Dim objListObject As ListObject
Set objRange = Intersect(Target, Columns(7))
If Not objRange Is Nothing Then
For Each objCell In objRange
If Not IsEmpty(objCell.Value) Then
If Not mobjDictionary.Exists(objCell.Value) Then
Call FillDictionary
For Each objListObject In ListObjects
With objListObject.DataBodyRange.Columns(7).Validation
Call .Delete
Call .Add(Type:=xlValidateList, Formula1:=Join(mobjDictionary.Keys, ","))
.ShowError = False
End With
Next
End If
End If
Next
Set objRange = Nothing
End If
End Sub
Public Sub FillDictionary()
Set mobjDictionary = CreateObject(Class:="Scripting.Dictionary")
Dim objListObject As ListObject
Dim avntValues As Variant, vntItem As Variant
For Each objListObject In ListObjects
avntValues = objListObject.DataBodyRange.Columns(7).Value
For Each vntItem In avntValues
If Not IsEmpty(vntItem) Then mobjDictionary.Item(vntItem) = vbNullString
Next
Next
End Sub

Gruß
Nepumuk

Beliebteste Forumthreads (12 Monate)

	A	B	C
1	w		a
2	e		e
3			q
4	s		r
5	t		s
6			t
7	q		w
8	t
9
10	s
11	a
12
13
14	r
15	w

Zelle	Formel
C1	=LET(l;SORTIEREN(EINDEUTIG(A:A));WENN(l=0;"";l))

Zelle	Gültigkeitstyp	Operator	Wert1	Wert2
A1	Liste		=C$1#

Zelle	Formel
C1	=SORTIEREN(EINDEUTIG(A1:A15))

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread