Datenüberprüfung aus Liste

Hallo zusammen,
Mir bereitet die abhängige Datenüberprüfung Kopfzerbrechen.
Die vereinfachte/exemlparische Situation:
Ich habe eine Tabelle mit 2 Spalten. In die erst (A:A) gebe ich einmalig vorkommende Bezeichnungen ein und weise diesen in der zweiten Spalte (B:B) eine Kategorie zu. Die Kategorien beziehe ich aus einer dynamischen (benannten) Liste. Soweit so gut.
Problem:
Nun möchte ich in einer weiteren Liste (auf einem anderen Tabellenblatt) eine Datenüberprüfung implementieren, die abhängig von der dort in Spalte (A:A) gewählten Kategorie (aus der benannten Liste) in Spalte (B:B) ein Dropdown anbietet, welches nur die Werte aus der ersten Tabelle ausgibt denen die entprechende Kategorie zugewiesen wurde. Mir scheint, dass es sich dabei um kein ungewöhliches Anliegen handeln dürfte.
Die Möglichkeit die abhängige Datenüberprüfung per Indirekt() zu lösen ist mir bekannt, aber nicht zielführend, da ich für jede Kategorie eine neue Tabelle (mit Name versehen) anlegen müsste. In meinem konkreten Fall gibt es aber zum Einen zu viele Kategorien und zum Anderen können ständig neue Kategorien hinzukommen.
Frage:
Welche Formel muss ich für die Datenüberprüfung benutzen, damit die Quelltabelle nach den Kategorien durchsucht wird und die zugehörigen Bezeichnungen zur Auswahl angeboten werden?
Ich habe bereits einige Kombinationen von Aggregat, Index, Vergleich, usw. versucht, komme aber zu keinem Ergebnis.
Falls dieses Problem schon einmal besprochen wurde und ich es hier nicht finden konnte, bitte ich um einen Link.
Beste Grüße,
Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo,
denn die VBA-Variante frisst unglaublich Performance.
wer sagt das?
In ein Modul:

Option Explicit
Public objKategorie As Object
Sub InitKategorie()
Dim rngC As Range, arrTmp, i As Long
Set objKategorie = CreateObject("Scripting.dictionary")
With Sheets(1)
arrTmp = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 2)
End With
For i = 1 To UBound(arrTmp)
If objKategorie.exists(arrTmp(i, 2)) Then
objKategorie(arrTmp(i, 2)) = _
objKategorie(arrTmp(i, 2)) & "," & arrTmp(i, 1)
Else
objKategorie(arrTmp(i, 2)) = arrTmp(i, 1)
End If
Next
End Sub

In Tabelle2:

Option Explicit
Private Sub Worksheet_Activate()
InitKategorie
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count = 1 Then
If Target.Column = 2 Then
If Target.Offset(, -1)  "" Then
If objKategorie Is Nothing Then InitKategorie
With Target.Validation
.Delete
.Add _
Type:=xlValidateList, _
AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, _
Formula1:=objKategorie(Target.Offset(, -1).Value)
.IgnoreBlank = True
.InCellDropdown = True
End With
End If
End If
End If
End Sub

Geht mit 5500 Artikeln in 50 Kategorien rasend schnell. Das merkst du gar nicht.
Gruß
Rudi

Sub InitKategorie() Dim rngC As Range, arrTmp, i As Long Set objKategorie = CreateObject("Scripting.dictionary") With Sheets(1) arrTmp = .Range(.Cells(2, 2), .Cells(Rows.Count, 1).End(xlUp)).Resize(, 3) End With For i = 1 To UBound(arrTmp) If objKategorie.exists(arrTmp(i, 3)) Then objKategorie(arrTmp(i, 3)) = _ objKategorie(arrTmp(i, 3)) & "," & arrTmp(i, 1) Else objKategorie(arrTmp(i, 3)) = arrTmp(i, 1) End If Next End Sub

Sub InitKategorie() Dim rngC As Range, arrTmp, i As Long Set objKategorie = CreateObject("Scripting.dictionary") With Sheets(1) arrTmp = .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp)).Resize(, 3) End With For i = 1 To UBound(arrTmp) If objKategorie.exists(arrTmp(i, 3)) Then objKategorie(arrTmp(i, 3)) = _ objKategorie(arrTmp(i, 3)) & "," & arrTmp(i, 1) Else objKategorie(arrTmp(i, 3)) = arrTmp(i, 1) End If Next End Sub

Beliebteste Forumthreads (12 Monate)

15 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

15
Beiträge zum Forumthread

Beiträge zu diesem Forumthread