Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
976to980
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
976to980
976to980
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Autofilter über mehrere Tabellenblätter

Autofilter über mehrere Tabellenblätter
21.05.2008 13:25:06
Markus
Hallo liebe Excel Freunde,
https://www.herber.de/bbs/user/52514.xls
Ich habe eine Datei mit Tabellen in vielen Tabellenblättern (Prinzip siehe Datei im Upload).
Alle sind bezüglich Zeilen- und Spaltenbeschriftung identisch (durch Blatt kopieren erzeugt)
Autofilter bei allen in Spalte A, B und C.
Die Werte in den Spalten D...E sind jedoch in jedem Tabellenblatt unterschiedlich.
Ich muss jeweils dieselbe Auswahl in allen Tabellenblättern anschauen.
Gibt es eine Möglichkeit mit einem Makro die Selektion von Autofilter in den Spalten A...C von Tabelle 1 automatisch auf die Auswahl von anderen Tabellenblättern zu übertragen. Dies würde mir eine enorme Zeitersparnis bringen?
Vielen Dank für Eure Hinweise und beste Grüsse
Markus

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Autofilter über mehrere Tabellenblätter
21.05.2008 14:51:00
Renee
Hi Markus,
Kopiere diesen Code in die Tabelle1.
Ein Doppelklick auf die Zelle A1 sollte alle Autofilter aller Tabelleblätter gleichstellen.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iX As Integer, iXF As Integer
Dim arrFilter()
If Target.Address  "$A$1" Then Exit Sub
Cancel = True
Application.EnableEvents = False
With ActiveSheet.AutoFilter
With .Filters
ReDim arrFilter(1 To .Count, 1 To 3)
For iXF = 1 To .Count
With .Item(iXF)
If .On Then
arrFilter(iXF, 1) = .Criteria1
If .Operator Then
arrFilter(iXF, 2) = .Operator
arrFilter(iXF, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
For iX = 2 To ActiveWorkbook.Worksheets.Count
With ActiveWorkbook.Worksheets(iX)
On Error Resume Next
.ShowAllData
On Error GoTo 0
For iXF = 1 To UBound(arrFilter(), 1)
If Not IsEmpty(arrFilter(iXF, 1)) Then
If arrFilter(iXF, 2) Then
.Range("A1:C1").AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1), _
Operator:=arrFilter(iXF, 2), Criteria2:=arrFilter(iXF, 3)
Else
.Range("A1:C1").AutoFilter _
field:=iXF, Criteria1:=arrFilter(iXF, 1)
End If
End If
Next iXF
End With
Next iX
MsgBox " Autofilter auf allen Blättern" & vbCrLf & _
"gemäss Blatt " & ActiveSheet.Name & " gesetzt!", _
vbOKOnly + vbInformation, "Auto-Autofilter"
Application.EnableEvents = True
End Sub


GreetZ Renée

Anzeige
AW: Autofilter über mehrere Tabellenblätter
21.05.2008 15:51:00
Markus
Hallo Renee,
Vielen herzlichen Dank für Deine Arbeit. Ich habe z.Z. keinen Zugriff auf die Originaldatei und brauche deshalb noch Zeit um Deinen Vorschlag einzubauen und zu testen.
Eine Frage vorab:
Im Original hat es noch weitere Tabellenblätter (ohne Autofilter). Wird das Makro trotzdem funktionieren?
Herzliche Grüsse
Markus

AW: Autofilter über mehrere Tabellenblätter
21.05.2008 16:33:00
Renee
Hi Markus,
Warum war die Information nicht in der Anfrage vorhanden.
Solche Sachen sind wichtig. Nein es wird nicht funktionieren.
Dann müssen die 'anderen' Blätter gezielt ausgeschlossen werden. Dazu müsste ich entweder die Blätternamen oder Indeces der 'Ausschluss'blätter wissen.
GreetZ Renée

Anzeige
AW: Autofilter über mehrere Tabellenblätter
21.05.2008 17:46:00
Markus
Hallo Renee,
Tut mir echt leid, die Originaldatei ist viel zu gross und enthält vertrauliche Daten. Ich habe deshalb versucht, das Problem mit einem Beispiel auf das wesentliche zu reduzieren.
Es gibt insgesamt 9 Tabellenblätter:
Tabellenblätter mit Autofilter (Auswahlfeld jeweils B5/C5/D5/E5):
Werk_0200
Werk_1600
Werk_1800
Werk_2900
Werk_2000

Tabellenblätter ohne Autofilter:
Download_SQ01
Download_MatNeu
Tabellen
Anleitung

Nochmals vielen Dank für Deine Geduld und beste Grüsse
Markus

AW: Autofilter über mehrere Tabellenblätter
21.05.2008 19:45:00
Renee
Hi Markus,
Ok. Der Code kann theoretisch in jedes Blatt mit Namen Werk_ kopiert werden. Er setzt alle Autofilter in diesen Blättern gleich (bei Doppelklick in die Zelle A1), wie das jeweilige aktive 'Werk_'Blatt.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iX As Integer, iXF As Integer
Dim arrFilter()
If Target.Address  "$A$1" Then Exit Sub
Cancel = True
Application.EnableEvents = False
With ActiveSheet.AutoFilter
With .Filters
ReDim arrFilter(1 To .Count, 1 To 3)
For iXF = 1 To .Count
With .Item(iXF)
If .On Then
arrFilter(iXF, 1) = .Criteria1
If .Operator Then
arrFilter(iXF, 2) = .Operator
arrFilter(iXF, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
For iX = 1 To ActiveWorkbook.Worksheets.Count
If Left(ActiveWorkbook.Worksheets(iX).Name, 5) = "Werk_" And _
ActiveWorkbook.Worksheets(iX).Name  ActiveSheet.Name Then
With ActiveWorkbook.Worksheets(iX)
On Error Resume Next
.ShowAllData
On Error GoTo 0
For iXF = 1 To UBound(arrFilter(), 1)
If Not IsEmpty(arrFilter(iXF, 1)) Then
If arrFilter(iXF, 2) Then
.Range("A1:C1").AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1), _
Operator:=arrFilter(iXF, 2), Criteria2:=arrFilter(iXF, 3)
Else
.Range("A1:C1").AutoFilter _
field:=iXF, Criteria1:=arrFilter(iXF, 1)
End If
End If
Next iXF
End With
End If
Next iX
MsgBox " Autofilter auf allen Blättern" & vbCrLf & _
"gemäss Blatt " & ActiveSheet.Name & " gesetzt!", _
vbOKOnly + vbInformation, "Auto-Autofilter"
Application.EnableEvents = True
End Sub


GreetZ Renée

Anzeige
Elimination von Fehlerquellen/Autofilter
21.05.2008 20:19:00
Fehlerquellen/Autofilter
Hi Markus,
Im folgenden Code sind noch einige Fehlerquellen eliminiert:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim iX As Integer, iXF As Integer
Dim arrFilter()
If Target.Address  "$A$1" Then Exit Sub
Cancel = True
If ActiveSheet.AutoFilterMode = False Then Exit Sub
Application.EnableEvents = False
With ActiveSheet.AutoFilter
With .Filters
ReDim arrFilter(1 To .Count, 1 To 3)
For iXF = 1 To .Count
With .Item(iXF)
If .On Then
arrFilter(iXF, 1) = .Criteria1
If .Operator Then
arrFilter(iXF, 2) = .Operator
arrFilter(iXF, 3) = .Criteria2
End If
End If
End With
Next
End With
End With
For iX = 1 To ActiveWorkbook.Worksheets.Count
If Left(ActiveWorkbook.Worksheets(iX).Name, 5) = "Werk_" And _
ActiveWorkbook.Worksheets(iX).Name  ActiveSheet.Name Then
With ActiveWorkbook.Worksheets(iX)
On Error Resume Next
.ShowAllData
On Error GoTo 0
For iXF = 1 To UBound(arrFilter(), 1)
If Not IsEmpty(arrFilter(iXF, 1)) Then
If arrFilter(iXF, 2) Then
.Cells.AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1), _
Operator:=arrFilter(iXF, 2), Criteria2:=arrFilter(iXF, 3)
Else
.Cells.AutoFilter field:=iXF, Criteria1:=arrFilter(iXF, 1)
End If
End If
Next iXF
End With
End If
Next iX
MsgBox " Autofilter auf allen Blättern" & vbCrLf & _
"gemäss Blatt " & ActiveSheet.Name & " gesetzt!", _
vbOKOnly + vbInformation, "Auto-Autofilter"
Application.EnableEvents = True
End Sub


GreetZ Renée

Anzeige
AW: Elimination von Fehlerquellen/Autofilter
22.05.2008 08:22:00
Fehlerquellen/Autofilter
Hallo Renee,
Ich habe deinen Code implementiert. Funktioniert exakt so, wie ich es mir vorgestellt habe.
Ich bin restlos begeistert!
Ich spare enorm viel Zeit und Nerven, da die Datei (möglicherweise wegen vieler Berechnungsformeln und bedingten Formatierungen über Formeln) sehr langsam ist.
Bildaufbau bei Blattwechsel: 10 sec (bei Berechnung auf manuell)
Neuberechnung: ca 1 min.
Nochmals vielen herzlichen Dank für Deine Unterstützung und Grüsse aus der Schweiz
Markus

300 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige