1.1k Aufrufe
Gefragt in Tabellenkalkulation von lerayz Einsteiger_in (87 Punkte)

Guten Tag,

folgendes Problem:

ich habe in den letzten Wochen mehrere Excel Dateien geschrieben, welche beliebig viele Blätter enthalten.
Jede Datei hat jedoch in der Spalte A-F die selben Daten. Also es sind immer die selben Produkte mit der selben Beschreibung. Die Reihenfolge ändert sich nur, wenn der Filter verändert wird.

Wenn ich jetzt bei einem Produkt etwas ändern möchte, muss ich auf jedem Blatt die Produktnummer im Filter eingeben, damit mir nur das Produkt angezeigt wird. Bei mehr als 50 Blättern ist das logischerweise ein ziemlicher "Aufwand".

Meine Frage lautet: Ist es möglich durch Makros (kenne mich leider damit noch nicht aus), die Filtereingabe auf einem beliebigen Blatt auszuführen, sodass ich auf jedem Blatt nur das eine Produkt angezeigt bekomme?
Super wäre es wenn es nicht Filter (Spalte) abhängig wäre (z.B. nur für den Filter Produktnummer aber nicht für Produkttyp), jedoch wäre auch das schon eine Erleichterung!!

Beispiel am Bild:

Ich möchte gerne alles über das Produkt 123456789 wissen. Gebe diese Nummer im Filter "Product Number" ein und wenn ich auf Blatt "Origin" wechsel, wird mir ebenfalls nur dieses Produkt angezeigt.
 

Oder um Produkte zu vergleichen: Gebe ich den Filter bei "Type of Product" auf Food und sehe auf alle Blättern alles Produkte unter Food.

Ich hoffe ich konnte mein Problem gut darstellen und mir kann geholfen werden.

35 Antworten

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Bearbeitet von m-o

Hallo,

bei einem Button aus dem Formularsteuerelement kannst du das Makro, das du dem Button zuordnen willst, aus einer Liste auswählen. Bei einem Button aus dem Active-X-Bereich musst du das Makro entweder hineinkopieren oder das Makro aufrufen:

Private Sub CommandButton1_Click()
Call filter_uebertragen
End Sub

Du kannst die Filter auch auf alle Dateien aus einem Ordner übertragen. Diese werden dann per Makro geöffnet, bearbeitet und wieder geschlossen.

Du schreibst, dass alle Tabellen gleich aufgebaut sind. Ist das aber wirklich so? Bei deiner Beispieltabelle waren die Daten als Tabelle formatiert. Ist das auch bei dem Tabellenblatt so, bei dem die Fehlermeldung kommt? Der Fehler deutet nämlich darauf hin, dass hier die Daten nur normal vorliegen und nicht als Tabelle formatiert.

Gruß

M.O.

0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
Tatsache! Die Daten konnte nicht zu einer Tabelle formatiert werden, da in der "Ergebniszeile" des öfteren die selbe Beschreibung steht. Wenn man das dann als Tabelle formatiert, hängt Excel immer eine Zahl hinten dran...
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
Kann man entweder a) Die Tabelle so formatieren, dass Excel keine Zahlen hinten dranhängt (oder sie nicht sichtbar sind)

oder b) Das Makro für alle Filter einstellen?
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)
Bearbeitet von m-o
Hallo,

ich werde mal schauen, ob ich ein Makro für alle Filterarten erstellen kann.

Ich hoffe, dass die doppelten Überschriften nicht die Spalten mit den Filtern betreffen.

Gruß

M.O.
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Okay das wäre cool.

Ich zeig dir mal ein Beispiel wie es aussieht. (Aktuelle Lösung)

Und ein Beispiel wie es aussieht wenn ich eine Tabelle einfüge. 


Ein Problem könnte sein, dass zwei Blätter der Datei als Tabelle formatiert sind und 2 nur als Tabelle dargestellt.

Aber zur Not kann ich die Formatierung zur Tabelle entfernen und sie nur so aussehen lassen.

0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

probiere mal den folgenden Code aus:

Sub Alle_Filter_ubertragen()
Dim intSpalte As Integer
Dim strTabelle As String
Dim i As Integer
Dim f As Integer
Dim arrFilter(6, 1) As Variant
Dim bFilter As Boolean
Dim intFilterzeile As Integer
Dim myListObject As Object

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'prüfen, ob Daten im aktuellen Arbeitsblatt als Tabelle vorliegen
Set myListObject = testListObjects(ActiveSheet.Name)

'nun Filter entsprechend Ergebnis einlesen
If myListObject Is Nothing Then
  'keine Tabelle
  'Filter durchlaufen
  For intSpalte = 1 To 6
    With ActiveSheet.AutoFilter.Filters(intSpalte)
       If .On Then
           arrFilter(intSpalte, 0) = Cells(ActiveSheet.AutoFilter.Range(1).Row, intSpalte).Value  'Überschrift des Filters in Array schreiben
          arrFilter(intSpalte, 1) = .Criteria1   'Kriterium in Array schreiben
          bFilter = True                       'Marker, dass Filter gefunden wurde
       End If
    End With
  Next intSpalte
 Else
  'Tabelle
   'Filter durchlaufen
   For intSpalte = 1 To 6
      With ActiveSheet.ListObjects(1).AutoFilter.Filters(intSpalte)
       If .On Then
          arrFilter(intSpalte, 0) = Cells(ActiveSheet.ListObjects(1).HeaderRowRange.Row, intSpalte).Value  'Überschrift des Filters in Array schreiben
          arrFilter(intSpalte, 1) = .Criteria1   'Kriterium in Array schreiben
          bFilter = True                       'Marker, dass Filter gefunden wurde
       End If
      End With
   Next intSpalte
End If

'Falls kein Filter gefunden, dann Hinweis und Abbruch des Makros
If bFilter = False Then
  MsgBox "Kein Filter gefunden! Abbruch", 64, "Hinweis"
  Exit Sub
End If

'Name des aktiven Arbeitsblatts in Variable schreiben
strTabelle = ActiveSheet.Name

'alle Arbeitsblätter in Arbeitsmappe durchlaufen
For i = 1 To ThisWorkbook.Worksheets.Count
  With ThisWorkbook.Worksheets(i)
    'nur die anderen Arbeitsblätter durchlaufen
    If .Name <> strTabelle Then
      'prüfen, ob Daten im aktuellen Arbeitsblatt als Tabelle vorliegen
      Set myListObject = testListObjects(.Name)
      If myListObject Is Nothing Then
         'keine Tabelle
         'ggf. vorhandene Filter aufheben
          If .FilterMode Then .ShowAllData
          'Filter übertragen, dazu gespeicherte Filter durchlaufen
          For f = 1 To 6
            'Überschriften vergleichen
             For intSpalte = 1 To 6
               If arrFilter(f, 0) = .Cells(.AutoFilter.Range(1).Row, intSpalte).Value Then
                  'Filter übertragen
                  .UsedRange.AutoFilter Field:=f, Criteria1:=arrFilter(f, 1)
               End If
             Next intSpalte
          Next f
       Else
         'ggf. gesetzte Filter zurücksetzen
          If .ListObjects(1).AutoFilter.FilterMode Then .ListObjects(1).AutoFilter.ShowAllData
          'nun Filter neu setzen
          For f = 1 To 6
            'richtiges Feld für Filter suchen
            For intSpalte = 1 To 6
               If .Cells(.ListObjects(1).HeaderRowRange.Row, intSpalte).Value = arrFilter(f, 0) Then
                 'Filter übertragen
                 .ListObjects(1).Range.AutoFilter Field:=intSpalte, Criteria1:=arrFilter(f, 1)
               End If
            Next intSpalte
          Next f
       End If
    End If
  End With
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

'Abschlussmeldung
 MsgBox "Die Filtereinstellungen wurden übertragen.", 64, "Hinweis"

'Variable zurücksetzen
Set myListObject = Nothing

End Sub


Function testListObjects(xTabelle As String) As Object
'hier wird geprüft, ob die Daten in einem Arbeitsblatt als Tabelle formatiert sind

Dim myListObject As Object

If ThisWorkbook.Worksheets(xTabelle).ListObjects.Count = 0 Then
    Set myListObject = Nothing
 Else
    Set myListObject = ThisWorkbook.Worksheets(xTabelle).ListObjects
End If

Set testListObjects = myListObject

Set myListObject = Nothing

End Function

Kopiere den Code inklusive der Function in ein allgemeines Modul.

Gruß

M.O.

0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
Wow du bist echt ein Held!

Es klappt!
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
Okay, da gibt es doch noch Probleme....

Er übernimmt immer nur eine Filter Option.

Beispiel: erste Spalte heißt Produkttyp. Dort möchte ich jetzt alle 2 von 10 Produkten anzeigen lassen, sagen wir mal Auto und Essen. Also setze ich bei den beiden ein "Haken" und führe das Makro aus.

Auf den anderen Blättern wird mir jetzt nur das obere Produkt angezeigt, also alle Autos.

Setze ich den Filter für Essen und Zeppeline, dann zeigt er mir Essen an.

Also er zeigt immer das oberste im Filter an.

Wähle ich jetzt aber Autos, Essen und Zeppelin zeigt er mir nur die Zeppeline an...

Zusammenfassung:
Möchte ich mir zwei Sachen Filtern lassen, zeigt er mir nur das oberste Produkt an.

Möchte ich mir mehr als zwei Sachen Filtern lassen, zeigt er mir nur das letzte Produkt an. Egal ob 3 oder 9 ausgewählt sind.
 

Setze ich nur einen Filter, also nur Autos, dann funktioniert es richtig. Jedoch kann ich dann nicht in der zweiten Spalte z.B. mehrere Marken Filtern, sonst habe ich wieder das selbe Problem wie oben.

Ich hoffe ich konnte das gut schildern.
0 Punkte
Beantwortet von m-o Profi (22.7k Punkte)

Hallo,

ich hatte das nicht ausgiebig getestet, da ich nur ein paar Datensaätze in der Testtabelle habe.

Ersetzte das vorhandene Makro durch den folgenden Code. Achte aber darauf, dass du die Function nicht löschst.

Hier der verbesserte Code:

Sub Alle_Filter_ubertragen()
Dim intSpalte As Integer
Dim strTabelle As String
Dim i As Integer
Dim f As Integer
Dim arrFilter(6, 4) As Variant
Dim bFilter As Boolean
Dim intFilterzeile As Integer
Dim myListObject As Object

'Bildschirmaktualisierung ausschalten:
'Application.ScreenUpdating = False

'prüfen, ob Daten im aktuellen Arbeitsblatt als Tabelle vorliegen
Set myListObject = testListObjects(ActiveSheet.Name)

'nun Filter entsprechend Ergebnis einlesen
If myListObject Is Nothing Then
  'keine Tabelle
  'Filter durchlaufen
  For intSpalte = 1 To 6
    With ActiveSheet.Autofilter.Filters(intSpalte)
       If .On Then
           arrFilter(intSpalte, 0) = Cells(ActiveSheet.Autofilter.Range(1).Row, intSpalte).Value  'Überschrift des Filters in Array schreiben
           arrFilter(intSpalte, 1) = .Count                                   'Anzahl Filterkriterien in Array schreiben
           arrFilter(intSpalte, 2) = .Operator                                'Operator in Array schreiben
           arrFilter(intSpalte, 3) = .Criteria1                               'Kriterium 1 in Array schreiben
           If .Count = 2 Then arrFilter(intSpalte, 4) = .Criteria2            'Kriterium 2 in Array schreiben
           bFilter = True                                                     'Marker, dass Filter gefunden wurde
       End If
    End With
  Next intSpalte
 Else
  'Tabelle
   'Filter durchlaufen
   For intSpalte = 1 To 6
      With ActiveSheet.ListObjects(1).Autofilter.Filters(intSpalte)
       If .On Then
          arrFilter(intSpalte, 0) = Cells(ActiveSheet.ListObjects(1).HeaderRowRange.Row, intSpalte).Value  'Überschrift des Filters in Array schreiben
          arrFilter(intSpalte, 1) = .Count                                   'Anzahl Filterkriterien in Array schreiben
          arrFilter(intSpalte, 2) = .Operator                                'Operator in Array schreiben
          arrFilter(intSpalte, 3) = .Criteria1                               'Kriterium 1 in Array schreiben
          If .Count = 2 Then arrFilter(intSpalte, 4) = .Criteria2            'Kriterium 2 in Array schreiben
          bFilter = True                                                     'Marker, dass Filter gefunden wurde
       End If
      End With
   Next intSpalte
End If

'Falls kein Filter gefunden, dann Hinweis und Abbruch des Makros
If bFilter = False Then
  MsgBox "Kein Filter gefunden! Abbruch", 64, "Hinweis"
  Exit Sub
End If

'Name des aktiven Arbeitsblatts in Variable schreiben
strTabelle = ActiveSheet.Name

'alle Arbeitsblätter in Arbeitsmappe durchlaufen
For i = 1 To ThisWorkbook.Worksheets.Count
  With ThisWorkbook.Worksheets(i)
    'nur die anderen Arbeitsblätter durchlaufen
    If .Name <> strTabelle Then
      'prüfen, ob Daten im aktuellen Arbeitsblatt als Tabelle vorliegen
      Set myListObject = testListObjects(.Name)
      If myListObject Is Nothing Then
         'keine Tabelle
         'ggf. vorhandene Filter aufheben
          If .FilterMode Then .ShowAllData
          'Filter übertragen, dazu gespeicherte Filter durchlaufen
          For f = 1 To 6
            'Überschriften vergleichen
             For intSpalte = 1 To 6
               If arrFilter(f, 0) = .Cells(.Autofilter.Range(1).Row, intSpalte).Value Then
                  'Filter übertragen
                  Select Case arrFilter(f, 1)
                     Case Is = 1
                       .UsedRange.Autofilter Field:=f, Criteria1:=arrFilter(f, 3), Operator:=arrFilter(f, 2)
                     Case Is = 2
                       .UsedRange.Autofilter Field:=f, Criteria1:=arrFilter(f, 3), Operator:=arrFilter(f, 2), Criteria2:=arrFilter(f, 4)
                     Case Is > 2
                       .UsedRange.Autofilter Field:=f, Criteria1:=Array(arrFilter(f, 3)), Operator:=arrFilter(f, 2)
                   End Select
               End If
             Next intSpalte
          Next f
       Else
         'ggf. gesetzte Filter zurücksetzen
          If .ListObjects(1).Autofilter.FilterMode Then .ListObjects(1).Autofilter.ShowAllData
          'nun Filter neu setzen
          For f = 1 To 6
            'richtiges Feld für Filter suchen
            For intSpalte = 1 To 6
               If .Cells(.ListObjects(1).HeaderRowRange.Row, intSpalte).Value = arrFilter(f, 0) Then
                 'Filter übertragen
                 Select Case arrFilter(f, 1)
                     Case Is = 1
                       .ListObjects(1).Range.Autofilter Field:=f, Criteria1:=arrFilter(f, 3), Operator:=arrFilter(f, 2)
                     Case Is = 2
                       .ListObjects(1).Range.Autofilter Field:=f, Criteria1:=arrFilter(f, 3), Operator:=arrFilter(f, 2), Criteria2:=arrFilter(f, 4)
                     Case Is > 2
                       .ListObjects(1).Range.Autofilter Field:=f, Criteria1:=Array(arrFilter(f, 3)), Operator:=arrFilter(f, 2)
                   End Select
                 End If
            Next intSpalte
          Next f
       End If
    End If
  End With
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

'Abschlussmeldung
 MsgBox "Die Filtereinstellungen wurden übertragen.", 64, "Hinweis"

'Variable zurücksetzen
Set myListObject = Nothing

End Sub

Gruß

M.O.

0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Super! Die Filter werden jetzt übernommen. 

Jedoch ein merkwürdiges Problem.

Ich habe eine Datei, wo nur ein Blatt vorhanden ist. Die Daten wurden nicht zu einer Tabelle formatiert, dort funktioniert das Makro problemlos.

Dann habe ich eine Datei von 2/7 Blättern als Tabelle formatiert sind, der Rest nicht. Wenn ich hier das Makro ausführen will bekomme ich die Meldung:
Laufzeitfehler '1004':
Die AutoFilter-Methode des Range-Objektes konnte nicht ausgeführt werden.

Sobald ich auf ,,Debuggen" klicken wird mir folgende Zeile gelb markiert
.UsedRange.AutoFilter Field:=f, Criteria1:=arrFilter(f, 3), Operator:=arrFilter(f, 2)

Das selbe Problem bei einer Datei wo ein Blatt (von 3) als Tabelle formatiert ist.

Jetzt kommt das wirklich komische. Bei einer Datei wo 3/5 als Tabelle formatiert sind, geht das Makro!

Datei 6/10 als Tabelle formatiert ebenfalls.

Also manchmal geht es manchmal nicht..

...