24 Aufrufe
Gefragt in Tabellenkalkulation von mistermo1984xx Einsteiger (8 Punkte)
Hallo zusammen

Ich bekomme jede Woche eine grosse Excelliste mit unterschiedlichen Positionen:

Artikel      Menge     KartonNr

1001         10           2

1002          8            2

1054          6            3

Für die Artikel trage ich jeweils die karton Nr ein, wo ich die erhaltenen Teile reinpacke und weiterverschicke.

Jedes Mal gehe ich über die Filterfunktion und filter mir wie folgt:

"Filter Karton 1 " dann sehe ich alles was in Karton 1 gepackt ist und drucke das aus. Dann filter ich nach Karton 2 und drucke alles, was in karton 2 ist etc.

Das ganze mache ich 100 mal...

Gibt es eine Möglichkeit das zu automatisieren??

Besten dank an euch!

Gruss

Maurice

2 Antworten

+1 Punkt
Beantwortet von beverly_ Mitglied (313 Punkte)

Hi Maurice,

das kannst du mit folgendem Makro lösen:

Sub Drucken()
    Dim objDictionary As Object
    Dim arrBereich As Variant
    Dim arrDaten As Variant
    Dim lngZaehler As Long
    Dim blnFilter As Boolean
    Set objDictionary = CreateObject("Scripting.Dictionary")
    With Worksheets("Tabelle1")
        If .AutoFilterMode = False Then
            .Range("A1").CurrentRegion.AutoFilter
            blnFilter = True
        Else
            .AutoFilter.ShowAllData
        End If
        arrBereich = .Range("C1", .Range("C1").End(xlDown))
        For lngZaehler = LBound(arrBereich) To UBound(arrBereich)
            objDictionary(arrBereich(lngZaehler, 1)) = 0
        Next
        arrDaten = objDictionary.keys
        For lngZaehler = LBound(arrDaten) + 1 To UBound(arrDaten)
            .Range("$A$1").CurrentRegion.AutoFilter Field:=3, Criteria1:=arrDaten(lngZaehler)
            .PrintOut
        Next lngZaehler
        If blnFilter = True Then .Range("$A$1").CurrentRegion.AutoFilter
    End With
    Set objDictionary = Nothing
End Sub


Bis später, Karin

0 Punkte
Beantwortet von mistermo1984xx Einsteiger (8 Punkte)
Hallo Karin

ich habe das Makro für meine Excelsheet nochmals angepasst - funktioniert super!!!

Besten Dank

Gruss

Maurice
...