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 lerayz Einsteiger_in (87 Punkte)
Das ist auch eigentlich der Fall! Das war tatsächlich die einzige Datei wo es in zwei Blättern vertauscht war...

Ich habe jetzt alle 3 Varianten von dir ausprobiert. Jedes mal Laufzeitfehler 91
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Nochmal eine exakte Kopie nur ohne Daten

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

Hallo,

probiere mal diese Version aus:

Sub filter_uebertragen()

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

'Bildschirmaktualisierung ausschalten:
Application.ScreenUpdating = False

'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

'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
  'nur die anderen Arbeitsblätter durchlaufen
  With ThisWorkbook.Worksheets(i)
   If .Name <> strTabelle Then
     'ggf. gesetzte Filter zurücksetzen
     If .ListObjects(1).AutoFilter.FilterMode Then .ListObjects(1).AutoFilter.ShowAllData

     'nun Filter neu setzen
     For f = 1 To 6
       'nur nichtleere Filter ansprechen
       If arrFilter(f, 1) <> "" Then
        '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
       End If
      Next f
    End If
  End With
Next i

'Bildschirmaktualisierung einschalten:
Application.ScreenUpdating = True

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

End Sub


Gruß

M.O.

0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Neue Meldung + andere Zeile wird markiert

In der Test Datei funktioniert es aber!
Habe aber wirklich nur die Daten entfernt...

Wenn ich die Daten aus der Original Tabelle entferne und dann das Makro eingebe ohne vorher zu speichern kommt jedoch der selbe Fehler.

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

Hallo,

setze vor die fett markierten Zeilen einfach mal ein Hochkomma:

 'nun Filter neu setzen
     For f = 1 To 6
       'nur nichtleere Filter ansprechen
       'If arrFilter(f, 1) <> "" Then           <<<<<<
        '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
      'End If               <<<<<<
 Next f

Probiere dann mal, ob der Code durchläuft.

Gruß

M.O.

0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Dann bekomme ich folgende Meldung

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

du musst auch vor das End If vor Next f ein Hochkomma setzen (siehe oben).

Gruß

M.O.
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
ES GEHT!!! DANKE!!!

Ich wollte dieses Makro jetzt in einen Button formatieren, sodass man nur darauf klicken muss, wenn man den Filter für alle Blätter verwenden will. Macht es einen Unterschied ob ich ein Formularsteuerelement oder ein Active-X Steuerelement nutze?
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)
Ist es eigentlich auch möglich mit einem Makro die Filter für alle Dateien im Ordner zu sortieren?

Ich wollte eben den Makro Button einfach kopieren und damit hat er dann die Filtereinstellungen in der Herkunftsdatei übernommen
0 Punkte
Beantwortet von lerayz Einsteiger_in (87 Punkte)

Okay, das Makro funktioniert bei 9/16 Dateien. Aber die Dateien sind alle gleich aufgebaut... Es sind nur mal mehr mal weniger Blätter vorhanden.

...