AW: Autofilter in Excel
30.08.2007 00:07:27
fcs
Hallo Markus,
ich habe dein Makro programmiertechnisch auf Vorderman gebracht und die weiteren Funktionen eingebaut. Der vom Recorder aufgezeichnete Code ist leider oft sehr unübersichtlich mit seinen Methoden "Select" und "Activate" und "Selection" für die gerade aktive Auswahl.
Besser ist es möglichst auf Select und Activate zu verzichten und Arbeitsmappen beim Öffnen entsprechenden Objektvariblen ( deklariert As Workbook) zuzuweisen. Entsprechendes gilt auch für Tabellenblätter.
Das Makro startet jetzt den Datei-Öffnen-Dialog zur Auswahl der Datei mit den Daten der KW. Soweit möglich hab ich den Code auch getestet. Es scheint Alles zu passen.
Gruß
Franz
Sub aTest()
'von fcs für Markus 2007-08-29
'Auszug von Dateien mit Daten für Kalenderwoche speichern.
Dim wb_KW As Workbook, wb_KW00 As Workbook
Dim wks_KW As Worksheet, Bereich As Range
Dim Zeile1 As Long, Spalte1 As Integer, Spalte2 As Integer
Dim varName, strKW As String
'Verzeichnis für KW-Dateien einstellen/wechseln
varName = "C:\Eigene Dateien\STÜLIAUSZUG"
' varName = "C:\Test" 'fcs Testzeile
If Dir(varName & "\*.*") "" Then
ChDir (varName)
End If
'Gewünschte KW-Datei im Dialogfenster wählen und öffnen
varName = Application.GetOpenFilename(Filefilter:="Exceldateien(*.xls), *.xls", _
Title:="Datei für Kalender-Woche öffnen", MultiSelect:=False)
If varName = False Then Exit Sub 'Abbrechen wurde gewählt
Set wb_KW = Workbooks.Open(FileName:=varName)
' Set wb_KW = Workbooks.Open(FileName:="C:\Eigene Dateien\STÜLIAUSZUG\A1_KW3407.xls")
Set wks_KW = wb_KW.Worksheets(1) 'Hier ggf. Nr derTabelle anpassen
wks_KW.Rows("1:1").ClearContents
Set wb_KW00 = Workbooks.Open(FileName:="J:\Projekte\AU_KW_00.xls", ReadOnly:=True)
' Set wb_KW00 = Workbooks.Open(FileName:="C:\Test\AU_KW00.xls", ReadOnly:=True) 'fcs Testzeile
wb_KW00.Worksheets(1).Rows("18:20").Cut 'Hier ggf. Nr derTabelle anpassen
wks_KW.Rows("1:1").Insert Shift:=xlDown
wb_KW00.Close SaveChanges:=False
wks_KW.Columns.AutoFit
'Autofilter in Tabelle einrichten
Zeile1 = 4
Spalte1 = 1 'Spalte A
Spalte2 = 11 'Spalte K
With wks_KW
'Prüfen ob Autofilter im Blatt aktiv und gf. Autofilter deaktivieren
If .AutoFilterMode = True Then
.AutoFilterMode = False
End If
'Bereich mit Daten
Set Bereich = .Range(.Cells(Zeile1, Spalte1), _
.Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, Spalte2))
'Autofilter für Bereich aktivieren
Bereich.AutoFilter
End With
'Kalenderwoche eingeben und in Zelle G1 eintragen
strKW = InputBox("Bitte Kalenderwoche eingeben:", "KW für Datenauszug")
If strKW = "" Then Exit Sub 'Abbrechen wurde gewählt
wks_KW.Range("G1").Value = Val(strKW)
'Neuen Dateinamen berechnen
varName = Left(wb_KW.FullName, Len(wb_KW.FullName) - 4) & "_Auszug" & ".xls"
'Datei speichern und schließen
' wb_KW.SaveAs FileName:=varName, Password:="", CreateBackup:=False 'fcs Testzeile
wb_KW.SaveAs FileName:=varName, FileFormat:=xlExcel2, Password:="", _
CreateBackup:=False, AddToMru:=True
wb_KW.Close
Application.WindowState = xlMinimized
End Sub