Filterergebnis auslesen

Hallo :)
Ich will den gesetzten Autofilter aus meiner Tabelle auslesen und ihn auf einem anderen Blatt ausgeben (sobald sich der Filter ändert, soll sich auch der Text der Zelle ändern)
Ich hatte schon diese tolle Funktion hier gefunden:
http://www.excel-inside.de/vba-loesungen/zellen-a-bereiche/937-autofilter-gefilterte-datensaetze-auslesen
Nun habe ich allerdings das Problem dass ich es nicht auf meine Bedürfnisse ändern kann. Der Benutzer muss bei dieser Formel immer den Bereich wählen. Dies möchte ich nicht. Der Bereich beginnt immer in Zeile 10 und das Ende ist Variabel, daher wollte ich mit der Variablen end_row arbeiten. Die Hauptfrage ist auch wie ich die Formel ändere, sodass das "rngBereich As Range" nicht mehr vorhanden ist. Egal was ich bisher versucht hatte zu ändern, es funktioniert nicht.
Hier erstmal der Code:

Public Function FILTERERGEBNIS(rngBereich As Range, _ Optional trenner = vbLf) As String 'Auslesen der gefilterten Daten 'Parameter 1: Zellbereich 'Parameter 2: Startzeile des Datenbereichs (ohne Überschrift) 'Parameter 3: Optional - Individueller Daten-Trenner 'Dimensionierung der Variablen Dim varArr As Variant Dim objDict As Object Dim intI As Integer Dim lngL As Long Dim lngStartZ As Long Dim end_row As Integer '*** von mir hinzugefügt end_row = Cells(9, 1).End(xlDown).Row '*** von mir hinzugefügt 'Bereich übergeben varArr = rngBereich 'varArr = Range("A10:A" & end_row) *** mein Vorschlag 'Objekt definieren Set objDict = CreateObject("Scripting.Dictionary") 'Startzeile der Liste aus Bereichsangabe auslesen lngStartZ = rngBereich(1, 1).Row '***Start ist immer in Zeile 10*** 'Datenbereich durchlaufen For intI = LBound(varArr, 2) To UBound(varArr, 2) For lngL = LBound(varArr, 1) To UBound(varArr, 1) 'Prüfen, ob Zeile eingeblendet ist If Cells(lngL + lngStartZ - 1, 1).Rows.Hidden = False Then 'Inhalt dem Dictionary-Objekt übergeben objDict(varArr(lngL, intI)) = 0 End If Next Next 'Inhalte zusammensetzen und der Funktion zurückgeben FILTERERGEBNIS = Join(objDict.keys, trenner) End Function

Dankeschön schonmal!

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

dim Bereich as range dim anzFilterzeilen as long Set Bereich = DeinWorksheet.Range("A1").CurrentRegion anzFilterzeilen = anzFilterzeilen + Intersect(Bereich.SpecialCells(xlVisible), Bereich. _ Columns(1)).Count - 1 'If anzFilerzeilen > 0 Then ' MsgBox anzFilerzeilen 'End If DeinWorksheet.Range("A1").CurrentRegion.Offset(1, 0).SpecialCells(xlCellTypeVisible) _ .EntireRow.Delete 'alle sichtbaren Zellen löschen 'AutofilterergebnisLoeschenOhneAbfrage

Hallo Tanja,
bei dem Code deen ich dir gegeben habe habe, brauchst Du in der formel nur noch die Spalte angeben, die Du beobachten willst. Das Problem ist, wenn Du mehrere Spalten beobachten willst und in eienr Zelle darstellen willst. Da das Filtern kein Event auslöst hab ich noch kein Weg gefunden festzustellen, in welcher Spalte der Filter ausgelöst wurde.
Wenn Du aber nur eine Spalte pro dargestellter Zelle beobahcten willst, dann geht es so. Die letzte Zeile wird in der formel berechnet. Evtl. muss da noch auf match umgestellt werden, damit auch ausgeblendete Zeilen betrachtet werden, falls das also noch gebraucht wird, schau ich mir das gerene an.
Dein Formelaufruf kann jetzt so lauten =FILTERRESOURCE_Neu(Tabelle1!E:E;" - ")
oder auch
=FILTERRESOURCE_Neu(Tabelle1!A:E;" - ")
aber dann musst du erst in die spalte klicken deren Autofilter du ändern willst.
Ich hoffe, es ist etwas klarer geworden, was die neue Funktion anders kann.
Du könntest auch noch eine Parameter übergeben Startzeile, dann ist s noch Variabler und die setzt Du da wo Du jetzt die 10 setzt.
Gruß
yummi

Public Function FILTERERGEBNIS(Optional trenner = vbLf) As String 'Auslesen der gefilterten Daten 'Parameter: Optional - Individueller Daten-Trenner 'Dimensionierung der Variablen Dim varArr As Variant Dim objDict As Object Dim intI As Integer Dim lngL As Long Dim end_row As Integer With Worksheets("Tabelle1") ' Tabellennamen anpassen !!! end_row = .Cells(9, 1).End(xlDown).Row varArr = .Range("A10:A" & end_row) 'Objekt definieren Set objDict = CreateObject("Scripting.Dictionary") 'Datenbereich durchlaufen For intI = LBound(varArr, 2) To UBound(varArr, 2) For lngL = LBound(varArr, 1) To UBound(varArr, 1) 'Prüfen, ob Zeile eingeblendet ist If .Cells(lngL + 9, 1).Rows.Hidden = False Then 'Inhalt dem Dictionary-Objekt übergeben objDict(varArr(lngL, intI)) = 0 End If Next lngL Next intI 'Inhalte zusammensetzen und der Funktion zurückgeben FILTERERGEBNIS = Join(objDict.keys, trenner) End With End Function

Option Explicit Function ListeFiltern(Optional xSpalte As Integer = 5, Optional trenner = vbCrLf) As _ String Application.Volatile Dim liObj As ListObject, rg1 As Range, rg2 As Range, _ objDict As Object 'ListObject - wurde erstellt durch 'Als Tabelle Formatieren' Set liObj = Tabelle1.ListObjects("Resource") 'Datenbereich der übergebenen Spalte Set rg1 = liObj.DataBodyRange.Columns(5).SpecialCells(12) Set objDict = CreateObject("Scripting.Dictionary") For Each rg2 In rg1.Cells 'Prüfen, ob Zeile eingeblendet ist If Not rg2.EntireRow.Hidden Then 'Inhalt dem Dictionary-Objekt übergeben objDict(rg2.Value) = 0 End If Next ListeFiltern = Join(objDict.keys, trenner) Set rg1 = Nothing Set rg2 = Nothing Set liObj = Nothing End Function

Beliebteste Forumthreads (12 Monate)

17 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

17
Beiträge zum Forumthread

Beiträge zu diesem Forumthread