Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Spezialfilter aus mehreren Tabellen VBA

Spezialfilter aus mehreren Tabellen VBA
15.10.2016 21:43:32
Luna
Hola liebes Forum da bin ich wieder.
Ich habe mehrere Tabellen von verschiedenen Maschinen wo ich die Wartungsarbeiten mit MaschinenNr., Datum Anfang, Datum Ende, Zeit, Name und Art der Wartung eingebe. Diese möchte ich nun filtern. Ich habe mir dazu ein Makro gebaut welches aber nicht funktioniert. Erkennt jemand den Fehler den ich drin habe?
Sub Filter_Grapadoras()
' Filter_Grapadoras Makro
' Tastenkombination: Strg+r
Dim lngLastRowCSR01 As Long
Dim lngLastRowCSR03 As Long
Dim lngLastRowCSR04 As Long
Dim lngLastRowCSR05 As Long
Dim lngLastRow As Long
lngLastRowCSR01 = Sheets("CSRH7202015.01.CC").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowCSR03 = Sheets("CSRH7202015.03.CC").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowCSR04 = Sheets("CSRH7202015.04.CC").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowCSR05 = Sheets("CSRH7202015.05.CC").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRowKr = Sheets("Criterios").Cells(Rows.Count, 1).End(x1Up).Row
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row
Sheets("Resultado").Select
Range("A1").Select
Sheets("CSRH7202015.01.CC").Range("A1:F" & lngLastRowCSR01).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _
Range("A1"), Unique:=False
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row
Sheets("CSRH7202015.03.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _
("A:" & lngLastRow), Unique:=False
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row
Sheets("CSRH7202015.04.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _
("A:" & lngLastRow), Unique:=False
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row
Sheets("CSRH7202015.05.CC").Range("A1:F" & lngLastRowCSR03).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets ("Criterios").Range("A2:F &, lngLastRowKr),CopyToRange:= _
("A:" & lngLastRow), Unique:=False
End Sub
Danke euch schon mal für die Mühe. Und seid bitte nicht zu kritisch mit meinem Makro.
Saludos Luna

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Spezialfilter aus mehreren Tabellen VBA
15.10.2016 23:11:06
Piet
Hallo Luna,
ich habe noch nie mit AdvancedFilter gearbeitet und verstehe überhaupt nicht was da passiert!!
Als altem Praktiker sind mir bei genauem Hinsehen 2 Dinge aufgefallen. Schau sie dir bitte mal an:
"A:" & lngLastRow - ("A:" mit einem ":" dahinter und dann LastRow kann nicht funktionieren!
Des weiteren faellt mir auf das da doppelt gemoppelt wird, und zwar bei diesem Codeteil:
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(x1Up).Row
Der Code ist oben schon definiert, aber du wiederholst ihn in jeder Zeile. Was aendert sich denn da?
Würde mich freuen wenn das Makro nach einer Kortrektur funktioniert. Lasse den Thread offen, weil ich
bei dem Theam AdvancedFilter kein Fachmann bin.
mfg Piet
Anzeige
AW: Spezialfilter aus mehreren Tabellen VBA
15.10.2016 23:32:12
Luna
Hola Piet, danke dir aber den Code habe ich so im Internet gefunden. Ich habe ihn nur mit meinen Tabellennamen angepasst. Er schmeißt mir nur hinter dem CopyToRange:=Range Fehler beim Kompilieren: Erwartet: Listentrennzeichen oder ) raus.
Saludos Luna
AW: Spezialfilter aus mehreren Tabellen VBA
15.10.2016 23:41:58
Luna
Und den Doppelpunkt in "A:" &lngLastRow habe ich gelöscht. Da habe ich beim ädern etwas falsch gemacht. Danke dir.
Luna
AW: Spezialfilter aus mehreren Tabellen VBA
16.10.2016 00:06:12
Luna
Einen Fehler habe ich schon gefunden. Hatte die " vergessen. Jetzt kommt der Fehler direkt in dieser Zeile und hinterlegt sie gelb.
lngLastRowCSR01 = Sheets("CSRH7202015.01.CC").Cells(Rows.Count, 1).End(x1Up).Row
Danke weiterhin für eure Hilfe
Saludos
Luna
Anzeige
AW: Spezialfilter aus mehreren Tabellen VBA
16.10.2016 00:10:44
Luna
Einen Fehler habe ich schon gefunden. Hatte die " vergessen. Jetzt kommt der Fehler direkt in dieser Zeile und hinterlegt sie gelb.
lngLastRowCSR01 = Sheets("CSRH7202015.01.CC").Cells(Rows.Count, 1).End(x1Up).Row
Danke weiterhin für eure Hilfe
Saludos
Luna
AW: Spezialfilter aus mehreren Tabellen VBA
16.10.2016 15:31:28
Piet
Hallo Luna,
ja, bei Fehlern kann man sich manchmal zum "Schänzchen" suchen, geht mir auch so. Ein Tipp:
Habe ich Tuck im Makro sezte ich mir an bestimmten Stellen im Makro einfach den Befehl Exit sub!!
z.b. vor: Sheets("Resultado").Select - und prüfe ob es wenigstens bis dahin fehlerfrei läuft?
Dann kann man mit Direktfenster oder Msgbox lngLastRowCSR01 sich die einzelnen LastZell Werte ansschauen. Damit prüfe ich ob der Bereich schon mal funktioniert, ohne zu sortieren. Alter Programmierertrick. Auf die Art und Weise kann man Fehler einkreisen. Hängt sich das Makro in der 1. Zeile auf (gelb) dann deaktiviere den Befehl durch ' vor lastZell, sieht so aus: 'lngLastRowCSR01=
Auf die Art und Weise siehst du ob die anderen lastZell Befehle funktionieren. Fehler eingekreist! Tritt die Störung nur bei diesem Blattnamen auf stimmt der Blattname nicht. Bitte Kontrollieren. In Sonderfällen, die ich nicht logisch erklaeren kann, half es mir den Blattnamen direkt aus der Tabelle zu kopieren und ins Makro einzusetzen. Bitte nicht wundern wenn es dann plötzlich funktioniert.
Fehler haben manchmal ihre eigenen Tücken. Ich konnte in 20 Jahren nicht alle logisch erklären!
mfg Piet
Anzeige
AW: Spezialfilter aus mehreren Tabellen VBA
16.10.2016 17:35:57
Luna
Hola liebes Forum,hat keiner mehr eine Idee wo mein Fehler liegt? Habe es versucht wie Piet geschrieben hat mit dem kopieren der Namen der einzelnen Tabellenblättern aber es funktioniert nicht. Er schmeißt mich direkt hier raus.
lngLastRowCSR01 = Sheets("CSR H720 2015.01.CC").Cells(Rows.Count, 1).End(x1Up).Row
Vielen Dank wie immer für eure Hilfe hier
Saludos Luna
AW: Spezialfilter aus mehreren Tabellen VBA
16.10.2016 21:43:31
Uwe
Hallo Luna,
ersetze die 1(Eins) durch den Buchstaben l!
Also aus
x1Up wird
xlUp.
Gruß Uwe
AW: Spezialfilter aus mehreren Tabellen VBA
17.10.2016 00:40:56
Luna
Danke Uwe dank der Hilfe in den Foren habe ich das schon geändert. Das Makro läuft auch jetzt. Nicht 100% wie gewollt aber es funktioniert. Das was jetzt noch nicht wie gewünscht funktioniert ist das er nur nach dem Kriterium "NOMBRE" richtig filtert. Wenn ich z.B. nach dem Kriterium "SERIAL" filtern möchte listet es mir in dem Sheet "RESULTADO" alle Maschinen auf. Wenn noch jemand Lust und eine Idee hat bin ich sehr dankbar. Hier mal das Makro was mir jemand grandioserweise schon geschrieben hat.

Sub FilterinPlace()
' Filter_Grapadoras Makro
' Tastenkombination: Strg+r
Dim lngLastRowCSR01 As Long
Dim lngLastRowCSR03 As Long
Dim lngLastRowCSR04 As Long
Dim lngLastRowCSR05 As Long
Dim lngLastRow As Long
lngLastRowCSR01 = Sheets("CSR H720 2015.01.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR03 = Sheets("CSR H720 2015.03.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR04 = Sheets("CSR H720 2015.04.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowCSR05 = Sheets("CSR H720 2015.05.CC").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRowKr = Sheets("Criterios").Cells(Rows.Count, 1).End(xlUp).Row
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Resultado").UsedRange.Offset(1).ClearContents
Sheets("CSR H720 2015.01.CC").Range("A1:F" & lngLastRowCSR01).AdvancedFilter Action:= _
xlFilterCopy, _
CriteriaRange:=Sheets("Criterios").Range("A2:F" & lngLastRowKr), CopyToRange:= _
Sheets("Resultado").Range("A1:F1"), Unique:=False
On Error Resume Next
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.03.CC").Range("A1:F" & lngLastRowCSR03)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
Parent.ShowAllData
End With
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.04.CC").Range("A1:F" & lngLastRowCSR04)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
.Parent.ShowAllData
End With
lngLastRow = Sheets("Resultado").Cells(Rows.Count, 1).End(xlUp).Row
With Sheets("CSR H720 2015.05.CC").Range("A1:F" & lngLastRowCSR05)
.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Sheets("Criterios").Range("A2:F" _
& lngLastRowKr)
.Offset(1).Copy Sheets("Resultado").Range("A" & lngLastRow + 1)
.Parent.ShowAllData
End With
Sheets("Resultado").Select
End Sub

Gracias y Saludos
Luna
Anzeige

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige