Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1180to1184
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
Inhaltsverzeichnis

Code für Autofilter mit Ausnahmen

Code für Autofilter mit Ausnahmen
Harald
Hallo zusammen,
ich muss wöchentlich Auswertungen pro Mitarbeiter ausdrucken.
Hierzu benutze ich den Autofilter.
Dieser filtert mir nacheinander die im Makro- Code eingegebenen Mitarbeiter und macht jeweils einen Ausdruck
Das sieht so aus:
Selection.AutoFilter Field:=1, Criteria1:="Mitarbeiter Meyer"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter Field:=1, Criteria1:="Mitarbeiter Müller"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Selection.AutoFilter Field:=1, Criteria1:="Mitarbeiter Schulz"
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
usw.
Nachteil:
Ich muss immer wieder den Code anpassen, wenn Mitarbeiter ausscheiden oder neue Mitarbeiter dazu kommen.
Wie muss der Code aussehen, damit mir alle möglichen Filter ausgedruckt werden?
Super wäre dann noch, wenn ich Ausnahmen definieren könnte. z.B.:
Ausnahme: Wenn der Eintrag des Filters mit "Postkorb....." beginnt.
Wäre toll, wenn das jemand hinbekommt.
Vielen Dank im voraus.
Gruß, Harald.
AW: Code für Autofilter mit Ausnahmen
01.10.2010 10:39:41
Klaus
Hallo Harald,
verzichte auf .select wan immer möglich.
Schau mal in diese Datei:
https://www.herber.de/bbs/user/71726.xls
Es gibt eine Tabelle "Daten". Dort habe ich ein paar Mitarbeiternamen eingetragen.
Das Makro druckt die Tabelle "Auswertung" x-mal, einmal für jeden Namen der in "Daten" steht. Einträge wie "Postkorb", "Mülleimer" oder "Hallo Welt" werden nicht gefiltert/gedruckt, solange sie nicht in der Liste in "Daten" stehen.
Wenn ein MA ausscheidet, kannst du einfach die Zelle in "Daten" löschen. Komm ein neuer hinzu, flickst du ihn unten dran.
Bekommst du das hin, den Code auf deine Datei anzupassen?
Grüße,
Klaus M.vdT.
Anzeige
AW: Code für Autofilter mit Ausnahmen
01.10.2010 10:43:24
Tino
Hallo,
lese zuerst alle Mitarbeiter in ein Array ein Filtere doppelte raus und
gehe diese danach in einer Schleife durch.
Hier ein Code Beispiel:
Sub Makro1()
Dim oDic As Object, meArray
Dim A As Long, MaxRow As Long

Set oDic = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Tabelle1")
  'Filter aufheben 
  If .FilterMode Then .ShowAllData
  
  'Bereich der Namen ohne Überschrift 
  MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  If MaxRow = 1 Then 'keine Namen 
    Exit Sub
  ElseIf MaxRow > 2 Then 'mehr als 1 Name 
    meArray = .Range("A2", .Cells(MaxRow, 1))
  Else 'nur ein Name in Liste 
    meArray = .Range("A2", .Cells(MaxRow, 2))
    Redim Preserve meArray(1 To Ubound(meArray), 1 To 1)
  End If



    'doppelte rausfiltern 
    For A = 1 To Ubound(meArray)
      oDic(meArray(A, 1)) = meArray(A, 1)
    Next
    
    meArray = oDic.Keys
    
    'Schleife über alle namen 
    For A = Lbound(meArray) To Ubound(meArray)
        .Columns(1).AutoFilter Field:=1, Criteria1:=meArray(A)
        'Code für Ausdruck 
        '... 
        '... 
    Next A
End With
End Sub
Gruß Tino
Anzeige
AW: Code für Autofilter mit Ausnahmen
01.10.2010 12:22:48
Harald
Hallo Klaus M.vdT,
vielen Dank, aber Dein Lösungsansatz funktioniert bei mir nicht, weil es sich immer wieder um eine neue Datei handelt, welche ich aus unserem Intranet erst erzeuge (nach Excel exportiere).
Mein Ansatz ist ja auch, dass ich ausgeschiedenen oder neue Mitarbeiter nicht händisch ergänzen muss.
Hallo Tino,
auch Dir vielen Dank, dass Du mir helfen möchtest.
Dein Ansatz scheint auch der richtige zu sein, funktioniert aber noch nicht so ganz.
Ich möchte an dieser Stelle nochmal erwähnen, dass meine VBA- Kenntnisse als "bescheiden" einzustufen sind.
Deinen Code habe ich zweimal ausprobiert und habe jeweils 8-10 Blätter ohne Daten (also gefilterten Mitarbeiter) ausgedruckt bekommen. Komischerweise in verschiedenen Reihenfolgen.
Die benötigten Blätter der vorhandenen Mitarbeiter waren allerdings auch dabei. Insofern ist die Lösung scheinbar nicht fern.
Muss ich außer dem Druckbefehl noch etwas in dem Code ergänzen.
Wie erkennt der Code die Filter, die ich nicht ausgedruckt haben möchte?
Ich habe mal eine Beispielsdatei mal hochgeladen.
https://www.herber.de/bbs/user/71728.xls
Hinweise:
1) die zu filternden Mitarbeiter sind in Spalte A ab Zeile 10
2) die ausgeblendeten Spalten werden nicht benötigt
3) Folgende Filter aus Spalte A sollen nicht ausgedruckt werden:
Filter in denen die Wörter "Postkorb" oder "Summe" vorkommen
Wer hilft mir bei der perfekten und papiersparenden Lösung?
Nochmals vielen Dank im voraus.
Gruß, Harald.
Anzeige
AW: Code für Autofilter mit Ausnahmen
01.10.2010 12:43:24
Tino
Hallo,
den Bereich musst Du auch anpassen und weil auch noch Leerzellen und die Fußzeile mit drin ist in der Liste
müssen wir dies auch noch ausschließen.
Sub Makro1()
Dim oDic As Object, meArray
Dim A As Long, MaxRow As Long

Set oDic = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Wochenmeldung")
  'Filter aufheben 
  If .FilterMode Then .ShowAllData
  
  'Bereich der Namen ohne Überschrift 
  MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  If MaxRow = 7 Then 'keine Namen 
    Exit Sub
  ElseIf MaxRow > 10 Then 'mehr als 1 Name 
    meArray = .Range("A10", .Cells(MaxRow, 1))
  Else 'nur ein Name in Liste 
    meArray = .Range("A10", .Cells(MaxRow, 2))
    Redim Preserve meArray(1 To Ubound(meArray), 1 To 1)
  End If

    'doppelte rausfiltern 
    For A = 1 To Ubound(meArray)
      If meArray(A, 1) <> "" Then 'keine leeren Zellen 
        If InStr(meArray(A, 1), "Liste erstellt am") = 0 Then 'keine Fußzeile 
            oDic(meArray(A, 1)) = meArray(A, 1)
        End If
      End If
    Next
    
    meArray = oDic.Keys
    
    'Schleife über alle namen 
    For A = Lbound(meArray) To Ubound(meArray)
        .Range("A7", .Cells(MaxRow, 1)).AutoFilter Field:=1, Criteria1:=meArray(A)
        
        'Code für Ausdruck 
        .PrintOut Copies:=1, Collate:=True
    Next A
End With
End Sub
Wenn die Ausdrucke durcheinander sind, mach nach dem Ausdruck eine kleine Pause.
Schreibe nach der Zeile
.PrintOut Copies:=1, Collate:=True
diese zwei Zeilen, die 5 steht für 5 Sekunden evt. anpassen.
Application.Wait Now + TimeSerial(0, 0, 5)
DoEvents

Gruß Tino
Anzeige
AW: Code für Autofilter mit Ausnahmen
01.10.2010 13:26:22
Harald
Hallo Tino,
das klappt ja schon sehr gut.
Wenn man jetzt noch die Ausdrucke mit den Filtern in denen die Worte "Summe" oder "Postkorb" vorkommen verhindern könnte wäre es perfekt.
Gruß, Harald.
AW: Code für Autofilter mit Ausnahmen
01.10.2010 13:29:58
Klaus
meArray(A)
Hallo Harald,
ich blicke Tino's Code nicht ganz, aber das ausschließen sollte so gehen:
        'Code für Ausdruck
IF meArray(A) = "Summe" or meArray(A) = "Postkorb" then
'do nothing
Else
.PrintOut Copies:=1, Collate:=True
End IF
Grüße,
Klaus M.vdT.
AW: Code für Autofilter mit Ausnahmen
01.10.2010 13:42:34
Harald
Hallo Klaus,
schön, dass Du dich auch wieder einschaltest.
Einen Haken gibt es noch:
Bei den Wörter "Postkorb" und "Summe" handelt es sich nur um einen Teil des Eintrages der Zelle.
Deshalb funktioniert es leider noch immer nicht, so wie ich es brauche.
Vielleicht, wenn man die Formel Links() mit 5 Stellen (also "Summe" oder "Postk") einbaut.
Ich weiß, aber leider nicht wie das bei VBA und einem Autofilter funktioniert.
Nochmals Danke an alle, die ihre Zeit für mein Prolem opfern.
Gruß, Harald.
Anzeige
Funktion LEFT in VBA?
01.10.2010 13:57:21
Klaus
Hallo Harald,
das ist easy ... aber ich komm grad nicht auf die Syntax. Ich mach daher mal nen Betreff und stell auf offen.
Grüße,
Klaus M.vdt.
AW: Code für Autofilter mit Ausnahmen
01.10.2010 15:44:46
JogyB
Hallo Harald,
If Left(meArray(A), 5) = "Summe" Or ...
oder
If meArray(A) Like "Summe*" Or ...
Gruß, Jogy
hier meine Version dazu...
02.10.2010 10:37:02
Tino
Hallo,
habe ein Array erstellt in dem Du Deine Ausnahmen eintragen und auch leicht erweitern kannst.
Sub Makro1()
Dim oDic As Object, meArray
Dim A As Long, MaxRow As Long
Dim ArrayAusnahme, booNot As Boolean, AA As Long

'Ausnahmen entsprechend erweitern 
ArrayAusnahme = Array("Summe", "Liste erstellt am", "Postkorb")

Set oDic = CreateObject("Scripting.Dictionary")

'Tabelle anpassen 
With Sheets("Wochenmeldung")
  'Filter aufheben 
  If .FilterMode Then .ShowAllData
  
  'Bereich der Namen ohne Überschrift 
  MaxRow = .Cells(.Rows.Count, 1).End(xlUp).Row
  If MaxRow = 7 Then 'keine Namen 
    Exit Sub
  ElseIf MaxRow > 10 Then 'mehr als 1 Name 
    meArray = .Range("A10", .Cells(MaxRow, 1))
  Else 'nur ein Name in Liste 
    meArray = .Range("A10", .Cells(MaxRow, 2))
    Redim Preserve meArray(1 To Ubound(meArray), 1 To 1)
  End If

    'doppelte rausfiltern 
    For A = 1 To Ubound(meArray)
      If meArray(A, 1) <> "" Then 'keine leeren Zellen 
            oDic(meArray(A, 1)) = meArray(A, 1)
      End If
    Next
    
    meArray = oDic.Keys
    
    'Schleife über alle namen 
    For A = Lbound(meArray) To Ubound(meArray)
        For AA = Lbound(ArrayAusnahme) To Ubound(ArrayAusnahme)
            booNot = InStr(meArray(A), ArrayAusnahme(AA)) > 0
            If booNot Then Exit For
        Next AA
        If Not booNot Then
            .Range("A7", .Cells(MaxRow, 1)).AutoFilter Field:=1, Criteria1:=meArray(A)
            'Code für Ausdruck 
            .PrintOut Copies:=1, Collate:=True
            'kleine Pause nach Ausdruck, eventuell anpassen oder löschen 
            Application.Wait Now + TimeSerial(0, 0, 5)
            DoEvents
        End If
        booNot = False
    Next A
    If .FilterMode Then .ShowAllData
End With
End Sub
Gruß Tino
Anzeige
Ausnahmen funktionieren leider nicht
02.10.2010 11:19:59
Harald
Hallo Tino, hallo Jogy,
vielen Dank für Eure Mühe.
Aber leider funktioniert das mit den Ausnahmen immer noch nicht und es werden auch weiterhin alle Einträge die mit "Summe..." oder "Postkorb..." beginnen ausgedruckt.
Könnt ihr Euch bitte nochmal des Problems annehmen!
Vielen Dank.
Und wie gesagt, "VBA bescheiden". Wäre schön, wenn der komplette Code zum kopieren eingetragen würde, weil ich mich mit "Arrays", "Schleifen" usw. überhaupt nicht auskenne. Ist aber ne super Sache.
Die 5 Sekunden Verzögerung pro Ausdruck sind übrigens nicht erforderlich.
Gruß, Harald.
Anzeige
AW: Ausnahmen funktionieren leider nicht
02.10.2010 11:39:38
Tino
Hallo,
geht doch?!
Hier die Mappe, anstatt des ausdrucks habe ich mal eine Msgbox eingebaut diese kannst Du wieder löschen.
https://www.herber.de/bbs/user/71741.xls
Gruß Tino
Hallo Tino,
02.10.2010 15:54:16
Harald
Hallo Tino,
vielen, vielen Dank, auch an die anderen Beteiligten für die Lösung meines Problems.
Jetzt funktioniert es und ich komme auch klar mit dem Code.
Grüße aus Köln
Harald G.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige