https://www.herber.de/forum/messages/1560574.html
Ich hatte es mal so versucht, wie Hajo es vorgeschlagen hatte
Duch die Arrayformel aber extreme Laufzeit.
Ich bin jetzt schon Weiter.. Habe also schon eine bereinigte KennListe
Um es genau dazustellen hole ich mal ganz weit aus und versuche es möglichst genau zu beschreiben.
Über Gültigkeiten, möchte ich die Kennliste im Dropdown angezeigt bekommen, reduziert um die Einträge, die in der Spalte schon vorhanden sind. Also voll dynamisch.
Ich habs über eine Schleife versucht, die neue Anzeigeliste zusammenzubauen.
Die Ausgangs Kennliste:
KennListe
A | |
1 | Kennungen |
2 | 20000 |
3 | 20030 |
4 | 20040 |
5 | 20050 |
6 | 20060 |
7 | 20220 |
8 | 20230 |
9 | 20240 |
10 | 20250 |
11 | 20260 |
12 | 20270 |
13 | 20280 |
14 | 20290 |
15 | 20300 |
Hier sind mögliche Nummern vorhanden. Die Liste hat ja Lücken, ist aber aufsteigend sortiert. Hat ca. 1000 Einträge.
Wenn ich jetzt in
Erfassung
D | E | F | |
1 | Kennung | ||
2 | 20030 | ||
3 | 20000 | ||
4 | 20040 | ||
5 | |||
6 | 20060 | ||
7 | |||
8 | |||
9 | |||
10 | 20050 | ||
11 |
eine Zelle in Spalte E anwähle, dann läuft dieses Ereignismakro und arbeitet die KennListe ab, Es wird verglichen, ob der jeweilige Kennlisteneintrag schon hier in der Spalte vorhanden ist, wenn nicht, dann Liste= Liste & DerEintarg & ", " usw.
Es sollen die
20030
20000
20040
usw.
nicht mehr vorgeschlagen werden.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call Var_Bel 'Variablen Belegung
If Target.Row = 1 Then Exit Sub
If Not Intersect(Columns(5), Target) Is Nothing Then
'*** Nur, wenn nur eine Zelle ausgewählt ist
If Target.Count = 1 Then
Call MachListe(Target)
End If
End If
End Sub
Private Sub MachListe(Zelle As Range)
Lr05 = Tb05.Cells(Tb05.Rows.Count, 1).End(xlUp).Row
Set RNG = Tb05.Cells(2, 1).Resize(Lr05, 1)
'Liste erzeugen
Dim Z
Liste = ""
For Each Z In RNG
If (WorksheetFunction.CountIf(Range("E:E"), Z.Value) = 0) Or Z = Zelle Then
Liste = Liste & Z.Value & ","
End If
Next
'*** Datenüberprüfung setzen
If Liste <> "" Then
With Zelle.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=Liste
.IgnoreBlank = False
.InCellDropdown = True
.ShowInput = True
.ShowError = True
End With
End If
End Sub
in einem ModulOption Explicit
'*** Variable zur gemeinsamen Nutzung deklinieren
Public Tb02 As Worksheet, Tb05 As Worksheet
Public Lr02 As Double, Lr05 As Double
Public RNG As Range, Liste As String
Public Belegt As Boolean 'Set nur 1x ausführen
Sub Var_Bel()
If Belegt = False Then
Set Tb02 = ThisWorkbook.Sheets("Erfassung")
Set Tb05 = ThisWorkbook.Sheets("KennListe")
Belegt = True
End If
End Sub
Das klappt auch ganz gut, braucht natürlich auch Rechenzeit,JETZT aber!!!!
2 Probleme
A)
Die Anzahl der Listeinträge scheint begrenzt. Ab einer, mir noch nicht bekannten Anzahl, kommt es zu eine Fehlermeldung beim setzen der Gültigkeit.
B)
Wenn ich so die Gültigkeit in Zellen gesetzt habe und die Datei speichere und wieder öffne, dann erscheinen diese Meldungen.
Drücke ich Ja
und dann auf den LOG-Datei Link
Hat jemand eine vielleicht ganz andere Lösung zu dem Problem oder/und eien Idee, wie ich B) abstellen kann?
Die Datei
mit Makros
https://www.herber.de/bbs/user/113871.xlsm
ohne Makros für, diejenigen, die sowas nicht aus dem Web laden
https://www.herber.de/bbs/user/113872.xlsx
Danke und Gruß Uwe