Excel VBA: Unterschiedliche Zellinhalte einer Spalte auslesen, ähnlich AutoFilter-Auswahl

Question

Hallo zusammen,

gibt es eine Möglichkeit, alle unterschiedlichen Einträge einer Spalte eines Excel-Sheets auszulesen, ähnlich der Auswahl, wie ich sie bei einem Autofilter bekomme?

Gibt es vielleicht sogar eine fertige Funktion, auf die man zurückgreifen kann?

Ich habe es aktuell so gelöst, dass ich die Spalte durchlaufe und den Eintrag in ein temporäre separates Blatt übernehme (vielleicht wäre ein Array auch schneller?), wenn der Eintrag dort noch nicht vorhanden ist. Allerdings dauert das relativ lange, die Tabelle hat rund 50 Spalten und knapp 2000 Zeilen..

Das ganze ist für einen selbstgebastelter Filter (den habe ich bereits fertig), mit dem man nicht so eingeschränkt ist, wie mit dem Standard-Autofilter, d.h. man kann mehr als 2 Bedinungen angeben (->5) und diese beliebig verknüpfen.
Bis das ganze aufgebaut ist (Werte auslesen (s.o.) und diese dann wieder als Gültigkeit an die einzelnen Zellen übergeben) dauert es allerdings 5 Minuten und das, obwohl ich Berechnung und Bildaktualisierung bereits ausgeschaltet habe, um etwas Zeit zu gewinnen..

Ich bin für jeden Tipp dankbar!

Jürgen

Answer 1

hi juergen :-)

hapert es jetzt mit dem array oder woran ^^

bei groesseren datenmengen sollte man formeln auf ein minimum setzen wie auch range bzw cells befehle vermeiden :-))

gruss nighty

Answer 2

Hallo nighty,

das mit dem Array habe ich hinbekommen, meine Frage war eigentlich, ob es vielleicht eine fertige Funktion gibt, die aus einem vorgegebenen Range alle unterschiedlichen Einträge ausliest und irgendwohin schreibt, in einen anderen Range, in ein Array ...

Die Funktion steckt in Excel ja bereits drin, wenn ich einen Autofilter setze, bekomme ich ja auch alle unterschiedlichen Einträge "zur Auswahl".

Die Idee war, irgendwie darauf oder auf etwas ähnliches zurückzugreifen (und dadurch vielleicht auch noch ein bißchen Bearbeitungszeit zu sparen..)

Gruß
Jürgen

Answer 3

hi jürgen :-)

dann zwei parade beispiele eines dictionary objekt

vorraussetzung
intensive einarbeitung der syntax

schneller gehts nimmer ^^

da waere deine laufzeit wohl nur in sekunden messbar :-))

gruss nighty

Sub TTNR_einfügen()
Dim MeinArr As Variant, Dic As Object
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("Auszug Log-Report")
MeinArr = .Range("A1:B" & .Range("B65536").End(xlUp).Row).Value
End With
Set Dic = CreateObject("Scripting.Dictionary")
For i = LBound(MeinArr, 1) To UBound(MeinArr, 1)
Dic(MeinArr(i, 2)) = MeinArr(i, 1)
Next
With Worksheets("A")
MeinArr = .Range("A1:B" & .Range("B65536").End(xlUp).Row).Value
End With
For i = LBound(MeinArr, 1) To UBound(MeinArr, 1)
If Dic.Exists(MeinArr(i, 2)) Then
MeinArr(i, 1) = Dic(MeinArr(i, 2))
End If
Next
With Worksheets("A")
.Range("A1").Resize(UBound(MeinArr, 1), UBound(MeinArr, 2)).Value = MeinArr
End With
Application.ScreenUpdating = True
Dic.RemoveAll
Set Dic = Nothing
End Sub

Option Explicit

Sub x()
Dim i As Long, arIn As Variant, j As Long, arOut As Variant
Dim objDic As Object
arIn = Range("A1").CurrentRegion
ReDim arOut(1 To UBound(arIn), 1 To 2)
arOut(1, 1) = arIn(1, 1)
arOut(1, 2) = arIn(1, 2)
Set objDic = CreateObject("scripting.dictionary")
For i = 2 To UBound(arIn)
If arIn(i, 2) = 1 Then objDic(arIn(i, 1)) = 1
Next
j = 1
For i = 2 To UBound(arIn)
If objDic.Exists(arIn(i, 1)) Then
j = j + 1
arOut(j, 1) = arIn(i, 1)
arOut(j, 2) = arIn(i, 2)
End If
Next
Range("D1:E1").Resize(j) = arOut
objDic.RemoveAll
Set objDic = Nothing
End Sub