Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Filterergebnis auslesen

Betrifft: Filterergebnis auslesen von: Tanja
Geschrieben am: 02.09.2014 13:12:05

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!

  

Betrifft: AW: Filterergebnis auslesen von: yummi
Geschrieben am: 02.09.2014 15:00:38

Hallo Tanja,


wenn es auch ein anderer Ansatz sein darf:
nach setzen deines Autofilters

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
hier werden alle gleichen Zeilen bis auf eine gelöscht. Das offset von 1,0 sorgt dafür das die Überschrift stehen bleibt. Anstatt delete kannst du natürlich auch copy machen. Ich hab damit ganz gute erfolge erzielt.

Gruß
yummi


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 02.09.2014 15:26:51

Hallo Yummi,

vielen Dank für den Code. Wenn ich es aber richtig verstehe funktioniert dein Code nur "einmalig" (man müsste das Makro also nochmal starten, sobald der Filter anders gesetzt ist). Das tolle - und genau was ich suche - an der Funktion Filterergebnis ist, dass sie automatisch bei jeder Änderung den aktuell gesetzten Filter anzeigen lässt.

Trotzdem nochmal danke! :)


  

Betrifft: AW: Filterergebnis auslesen von: yummi
Geschrieben am: 02.09.2014 15:39:30

Hallo Tanja,

lad doch mal eine Beispieldatei hoch, so weit wie du es schon hast, dann schau ich mir das mal an

Gruß
yummi


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 10:36:08

Hallo Yummi,

wie gewünscht die Beispieldatei ;)

https://www.herber.de/bbs/user/92449.xlsm

Wie gesagt, bisher funktioniert der Code, allerdings möchte ich nicht dass der Nutzer den Bereich in der Formel selbst wählen soll.

Nochmal die Eckdaten:
- Beginn der Filterung immer in Zelle 10 (Zelle 9 Überschriften)
- Auswertung immer nur für Spalte E nötig
- Tabellenende soll durch eine Variable ermittelt werden, wie z.B. mit
end_row = Cells(9, 1).End(xlDown).Row

Danke! :)


  

Betrifft: AW: Filterergebnis auslesen von: yummi
Geschrieben am: 03.09.2014 12:52:01

Hallo Tanja,

ich hab mal kurz auf die schnelle was gebastelt, kann aber erst morgen wieder gucken. Wollte dir das nicht vorenthalten, vielleicht hilft es schon. Ich habe eine Funktion _neu geschrieben.
Für den Aufruf musst Du angeben welcher Bereich beobachtet werden soll. Es geht also jetzt mit einem Aufruf über mehrere Spalten. Der Nachteil momentan ist noch, dass Du die Zele des Autofilters aktivieren musst (da muss ich nochmal schauen, ob das besser geht) und dann den Auotfilter einstellen. Man kann den Autofilter ja auch einstellen ohne die Zelle zu aktivieren. Aber dafür findet sich bestimmt auch noch was.

Also schau mal in die Datei, bis dahin geht jetzt etwas mehr, ich hoffe es geht in die richtige Richtung.

https://www.herber.de/bbs/user/92454.xlsm

Gruß
yummi


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 15:55:43

Hallo Yummi,

ich habe deinen Code zwar zum Laufen gebracht, allerdings aktualisiert er nicht bei Änderungen der Filters die Ausgabe. Wie gesagt mit dem anderen Code funktioniert dieser Punkt super und ich möchte den Code eigentlich nur anpassen auf einen fest gewählen Bereich (Spalte 5, Zeile 10 bis end_row)...
Und daran scheitere ich, weil ich ständig irgendwelche Fehlermeldungen erhalte :(


  

Betrifft: AW: Filterergebnis auslesen von: yummi
Geschrieben am: 04.09.2014 09:19:50

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


  

Betrifft: AW: Filterergebnis auslesen von: ChrisL
Geschrieben am: 02.09.2014 15:51:24

Hi Tanja

Ich denke so müsste es gehen:

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

In der angegebenen Zelle musst du den Tabellennamen anpassen. Du erwähnst, dass die Funktion in einer anderen Tabelle verwendet wird, darum die Referenzierung auf die Tabelle.

Problem ist, dass sich die Funktion auf einem anderen Blatt nicht automatisch aktualisiert. (beim Testen hat Application.Volatile nichts gebracht)

Darum Vorschlag: In dem Tabellenblatt wo die Funktion steht ein "Calculate". Range("A1") ist die Zelle wo die Funktion drin steht, also auch anpassen.
Private Sub Worksheet_Activate()
Range("A1").Calculate  ' anpassen!!!
End Sub
Während der Code für die Funktion im Standardmodul steht (dort wo er vermutlich jetzt schon drin ist), musst du den Activate-Code im Modul der betroffenen Tabelle reinschreiben.

cu
Chris


  

Betrifft: AW: Filterergebnis auslesen von: Luschi
Geschrieben am: 02.09.2014 18:10:08

Hi Tanja,

hier noch 2 Beispiele von mir:
- mit Autofilter
- mit gefilterter Liste

https://www.herber.de/bbs/user/92444.xlsm

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 10:19:16

Hallo Chris,

der Code funktioniert zwar wenn ich ihn anpasse so auch, aber er aktualisiert sich nicht (wie du ja geschrieben hast). Wenn ich den bisherigen Code (den ich gepostet hatte) nehme aktualisieren sich die Wert automatisch bei jeder Änderung des Filters. Ich sehe allerdings keinen Unterschied der dies ausmachen könnte zwischen deinem Code und "meinem" Code. Hast du hierzu eine Idee?


Hallo Luschi,

deinen Code bekomme ich nicht so ganz angepasst. Als Ausgabe erhalte ich nur "#Wert"

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
Das fett markierte wurde von mir angepasst / geändert.

Schonmal vielen Dank für eure Mühe!


  

Betrifft: AW: Filterergebnis auslesen von: Luschi
Geschrieben am: 03.09.2014 13:06:25

Hallo Tanja,

da wird es wohl am Einfachsten sein, eine Demodatei mit unwichtigen Daten (keine Firmeninfos)
hier bereit zu stellen. Alles andere wird nur Raterei.

Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 13:46:37

Hallo Luschi,

die Datei hatte ich heute morgen schonmal hochgeladen. Allerdings aktualisiert die Forumsliste hier nicht sehr schnell? Hatte es in Bezug auf Yummi's Anfrage hochgeladen.

Hier nochmal der Link:
https://www.herber.de/bbs/user/92449.xlsm

Liebe Grüße

Tanja


  

Betrifft: AW: Filterergebnis auslesen von: Luschi
Geschrieben am: 03.09.2014 14:46:31

Hallo Tanja,

versuche doch selbst, diese Datei herunterzuladen. Bei mir kommt immer die Fehlermeldung, daß _ es diese Datei nicht gibt:

Multiple Choices
The document name you requested (/bbs/user/92449.xlsm) 
could not be found
on this server. However, we found documents with names similar to the one you requested.
Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 15:03:58

Sorry, heute morgen ging der Link.

Hier nochmal neu:
https://www.herber.de/bbs/user/92460.xlsm


  

Betrifft: AW: Filterergebnis auslesen von: Luschi
Geschrieben am: 03.09.2014 18:38:18

Hallo Tanja,

hier meine Lösung: https://www.herber.de/bbs/user/92468.xlsm


Gruß von Luschi
aus klein-Paris


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 03.09.2014 10:20:41

Mmh fett markieren im Code funktioniert wohl nicht.


  

Betrifft: AW: Filterergebnis auslesen von: Tanja
Geschrieben am: 08.09.2014 10:54:45

Vielen Dank Luschi und Yummi! Ich habe nun ein funktionierendes Makro ;)


 

Beiträge aus den Excel-Beispielen zum Thema "Filterergebnis auslesen"