Makro kürzer u. schneller ?
25.04.2009 18:40:42
Kurt
ich habe für das Filtern der Daten u. die entsprechende Anzahl
in eine Zelle folgendes Makro gefertigt:
Sub Auszählen()
Application.ScreenUpdating = False
Range("A5:AC5").Select
If Not ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
Selection.AutoFilter Field:=13, Criteria1:="216"
ActiveSheet.Range("A4").Select
Selection.Copy
ActiveSheet.Range("AH1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
'Exit Sub
Selection.AutoFilter Field:=13, Criteria1:="21601"
ActiveSheet.Range("A4").Select
Selection.Copy
Range("AH2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter Field:=13, Criteria1:="21603"
ActiveSheet.Range("A4").Select
Selection.Copy
ActiveSheet.Range("AH3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter Field:=13, Criteria1:="21604"
ActiveSheet.Range("A4").Select
Selection.Copy
ActiveSheet.Range("AH4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Selection.AutoFilter Field:=13, Criteria1:="21605"
ActiveSheet.Range("A4").Select
Selection.Copy
ActiveSheet.Range("AH5").Select
' ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
If ActiveSheet.AutoFilterMode Then
Selection.AutoFilter
End If
' ActiveSheet.Range("AG1:AI5").Select
' ActiveSheet.PageSetup.PrintArea = "$AG$1:$AI$5"
' ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
ActiveSheet.Range("C3").Select
Application.ScreenUpdating = True
End Sub
Kann man das Makro auch kürzer u. vielleicht schneller gestalten, da jedesmal ja Filter gesetzt
wird etc. dauert etwas`?
herzlichen Abendgruß Kurt aus K