Selektive Auswahl im Drop-Down Feld

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hi Martin,
bei einem solch großen Datenbereich verbietet sich eine Formellösung (viel zu langsam).
Stattdessen VBA.
Du hast 2 Tabellen - Tabelle1 und Tabelle2.
In Tabelle2 (Hilfstabelle) erzeugst Du in Spalte A die Zahlen von 0 bis 10000. Dem gesamten Bereich (Tabelle2!A1:A10001) gibst Du den Namen Nummern.
In Tabelle1, Spalte A gibst Du die Namen ein. Die gesamte Spalte B versorgst Du mit Daten-Gültigkeit-Liste-Zulassen: Nummern
Jetzt wechsel in die VBA-Umgebung (mit Alt+F11). Links im Projektexplorer Doppelklick auf Tabelle1.
In das rechte Fenster kopierst Du diesen Code und schließt den VBA-Editor wieder.


Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 2 And IsNumeric(Target) Then
With Tabelle2
.Rows(.Columns(1).Find(Target).Row).Delete
End With
End If
End Sub

Bei jeder neuen Nummernauswahl wird die Nummer aus dem Bereich Tabelle2!A1:A10001 gelöscht. Der Name Nummern passt sich dadurch immer an (Ausnahme: erster und letzter Eintrag).
Grüße Boris

Option Explicit Public oldValue As Variant Private Sub Worksheet_Change(ByVal Target As Range) Dim C As Range, lRow As Long With Target If .Column = 2 And .Count = 1 Then If .Value = "" And IsNumeric(oldValue) Then Set C = Tabelle2.Range("A:A").Find(oldValue, lookat:=xlWhole) If C Is Nothing Then On Error Resume Next lRow = WorksheetFunction.Match(oldValue, Tabelle2.Columns(1)) If Err.Number 0 Then lRow = 1: Err.Clear On Error GoTo 0 Tabelle2.Rows(lRow + 1).Insert Tabelle2.Range("A" & lRow + 1) = oldValue End If Else Tabelle2.Rows(Tabelle2.Columns(1).Find(.Value).Row).Delete End If End If End With oldValue = Target(1) End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) oldValue = Target(1) End Sub

Hi Martin,
also die von Dir genannte Zeile sollte eigentlich nicht angemeckert werden - aber was soll´s. Kleine Modifizierung des bisherigen Codes:


Option Explicit
Public oldValue As Variant
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C As Range, lRow As Long
With Target
If .Column = 2 And .Count = 1 Then
If .Value = "" And IsNumeric(oldValue) Then
Set C = Tabelle2.Range("A:A").Find(oldValue, lookat:=xlWhole)
If C Is Nothing Then
On Error Resume Next
lRow = WorksheetFunction.Match(oldValue, Tabelle2.Columns(1))
If Err.Number  0 Then lRow = 1: Err.Clear
On Error GoTo 0
Tabelle2.Rows(lRow + 1).Insert
Tabelle2.Range("A" & lRow + 1) = oldValue
End If
Else
If IsNumeric(.Value) Then Tabelle2.Rows(Tabelle2.Columns(1).Find(.Value).Row).Delete
End If
End If
End With
oldValue = Target(1)
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
oldValue = Target(1)
End Sub

Und jetzt noch ein Code, der den Ursprungszustand wiederherstellt (Voraussetzung ist, dass es den Namen Nummern bereits gibt) - Code gehört in ein allgemeines Modul:


Option Explicit
Sub Ursprung_wiederherstellen()
If MsgBox("Wirklich den Ursprung wiederherstellen?", vbYesNo, "Nachfrage") = vbYes Then
With Tabelle2
ThisWorkbook.Names("Nummern").RefersTo = .Range("A1:A10002")
.Range("A:A").Clear
.Range("A2:A10001").Formula = "=ROW()-1"
.Range("A2:A10001").Value = .Range("A2:A10001").Value
Tabelle1.Range("B2:B10000").ClearContents
End With
End If
End Sub

Grüße Boris

Beliebteste Forumthreads (12 Monate)

Selektive Auswahl im Drop-Down Feld

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

226 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Selektive Auswahl im Drop-Down Feld

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

226 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread