Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
908to912
908to912
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Spezialfilter mit Variablen funktioniert nicht

Spezialfilter mit Variablen funktioniert nicht
18.09.2007 15:03:00
Andreas
Hallo,
nachdem ich bisher all meine Makroprobleme mit dem Archiv klären konnte nun mein erster Beitrag.
Es geht um die Auswertung bzw. den Vergleich 2er Arbeitsmappen. Funktioniert auch alles recht gut, bis auf den Spzialfilter. Ich schaffe es einfach nicht die Sheets so anzusprechen, dass die Auswertung auch in der nächsten Kalenderwoche noch funktioniert.
Das funktioniert:
Workbooks(File).Sheets(name_such & kw_such).Range("B1:E33").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Workbooks("gef0637.xls").Sheets("gef0637Mo").Range("A1:A870") _
, CopyToRange:=Workbooks(File).Sheets("Gefiltert").Range("A1:D1"), Unique:=False

und das funktioniert leider nicht mehr:

Workbooks(File).Sheets(name_such & kw_such).Activate
Workbooks(File).Sheets(name_such & kw_such).Range(Cells(1, 2), Cells(letzte_zeile, 5)).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Workbooks(File_gef).Sheets("gef" & team_such & kw_such & "Mo").Range("A1", Range("A65536").End(xlUp)) _
, CopyToRange:=Workbooks(File).Sheets("Gefiltert").Range("A1:D1"), Unique:=False
Weis jemand Rat?
Gruß,
Andreas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spezialfilter mit Variablen funktioniert nicht
18.09.2007 15:08:00
Andreas
Achso, hier ncoh der komplette Coden,
auch wenn er recht lang ist, aber ihr Cracks könnt das ja lesen wie ich ein Buch...
ab 'Spezialfilter hängt es mit der Fehlermeldung Laufzeitfehler 1004 Anwendungs- oder Objektorientierter Fehler

Sub KW_auswerten()
' KW_auswerten Makro
' Makro am 17.09.2007 von Andreas Werner erstellt
' Tastenkombination: Strg+a
With Range("B5:BA5").Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
If MsgBox("Ist die Zelle mit der KW die aktualisiert werden soll ausgewählt?", vbYesNo) =  _
vbNo Then GoTo ende
Range("B5:BA5").Interior.ColorIndex = xlNone
'Einlesen der Suchdaten
kw_such = ActiveCell.Value
name_such = Cells(3, 18).Value
jahr_such = Cells(3, 4).Value
team_such = Cells(3, 12).Value
'Relevante Dateien öffnen
Dim Pfad, File As String
Pfad_gef = "L:\Auswertungen\Gefährdete Endtermine FT" & team_such & "\" & jahr_such & "\"
File_gef = "gef" & team_such & "" & kw_such & ".xls"
Pfad = "L:\Auswertungen\Produktivität FT" & team_such & "\" & jahr_such & "\ _
Einzelproduktivität\" & name_such & "\"
File = "" & name_such & "" & kw_such & ".xls"
Workbooks.Open Filename:=Pfad_gef + File_gef
Workbooks.Open Filename:=Pfad + File
'Persönlliche Rückmeldezeit der KW nach erster Spalte sortieren und Variablen übergeben
With Workbooks(File).Sheets(name_such & kw_such)
.Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Cells.Find(What:="Rückmeldetezeit (M) gesamt:", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
rückmeld_m_ges = ActiveCell.Offset(0, 5)
Cells.Find(What:="Rückmeldetezeit (P) gesamt:", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
rückmeld_p_ges = ActiveCell.Offset(0, 5)
Cells.Find(What:="Anwesenheitszeit gesamt:", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
anwesenheit_ges = ActiveCell.Offset(0, 5)
End With
'Letzte Zeile der Fertigungsauftträge festlegen
Range("B1:B500").Select
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:= _
xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
letzte_zeile = ActiveCell.Row
'Spalten tauschen
Columns("H:H").Select
Selection.Cut
Columns("C:C").Select
ActiveSheet.Paste
Columns("Q:Q").Select
Selection.Cut
Columns("D:D").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Range("B1").Value = ("Auftrags-Nr")
Range("C1").Value = ("Bez")
Range("D1").Value = ("Vorgangsbeschreibung")
Range("E1").Value = ("Rest Au")
'Berechnung Rest Au
For i = 2 To letzte_zeile
Cells(i, 5).FormulaR1C1 = "=IF(RC[7]0,RC[7],RC[8]+RC[9])"
Next i
Range(Cells(2, 5), Cells(letzte_zeile, 5)).NumberFormat = "0.00"
'Zusatzblatt einfügen
Sheets.Add
With Sheets("Tabelle1")
.Select
.Move After:=Sheets(2)
.Name = "Gefiltert"
End With
'Filtern der Rückgemeldeten Zeiten nach "Auftragsnummer in der gefährdeten Liste vorhanden"
'Korrektur für einsatz Spezialfilter
Workbooks(File_gef).Sheets("gef" & team_such & kw_such & "Mo").Activate
Range("A1").FormulaR1C1 = "Auftrags-Nr"
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
'Spezialfilter
Workbooks(File).Sheets(name_such & kw_such).Activate
Workbooks(File).Sheets(name_such & kw_such).Range(Cells(1, 2), Cells(letzte_zeile, 5)). _
AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Workbooks(File_gef).Sheets("gef" & team_such & kw_such & "Mo").Range( _
"A1", Range("A65536").End(xlUp)) _
, CopyToRange:=Workbooks(File).Sheets("Gefiltert").Range("A1:D1"), Unique:=False
Range("D22").Select
ActiveCell.FormulaR1C1 = "=SUM(R[-20]C:R[-1]C)"
Range("D21").Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlDouble
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Range("A1").Select
ende:
End Sub


Anzeige
AW: Spezialfilter mit Variablen funktioniert nicht
18.09.2007 15:22:00
Andreas
Hier noch die Dateien die zum Testen benötigt werden in abgespeckter Form.
https://www.herber.de/bbs/user/46140.xls
https://www.herber.de/bbs/user/46141.xls
https://www.herber.de/bbs/user/46142.xls
Die 46140 heißt eigentlich "moser37"
Die 46141 heißt eigentlcih "gef0637"
In der 46142 ist das Makro enthalten und soll später die Ergebnisse darstellen
Das Makto sucht die Dateien allerdings in einer Dateistruktur unter L:\ ,was ich noch abändern müsste falls es notwendig ist

Anzeige
AW: Spezialfilter mit Variablen funktioniert nicht
19.09.2007 08:46:30
Andreas
Hallo, Problem ist behoben. Dass der Bereich mit dem Kriterium Variabel ist musste ich vorher die Adresse der letzten Zelle an i übergeben. Hat mich aber bestimmt 2 stunden gekostet. *aller Anfang ist schwer*
'Spezialfilter
i = ActiveCell.Address
Sheets(name_such & kw_such).Columns("B:E").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("A1:" & i), CopyToRange:=Range("C1"), Unique:=False

353 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige