AW: Werte In Tab 2 suchen und nach Tab 1 kopieren
15.04.2009 16:04:33
fcs
Hallo Peter,
eigentlich macht es keinen Sinn, den Autofilter "nachzubauen".
Wenn du nur bestimmte Spalteninhalte in die 2. Tabelle übertragen möchtest, dann ist es einfacher, die Filter wie gewohnt in "Alle Werte" zu setzen und dann von allen nach dem Filtern sichtbaren Zeilen die Inhalte der gewünschten Spalten in die 2. Tabelle zu übertragen.
Zusätzlich kannst du über den Ansichtenmanager die Ansicht relativ schnell immer so einstellen, dass nur die Spalten von den ca. 25 angezeigt werden, die du während des Setzens der Filter angezeigt haben möchtest.
Gruß
Franz
Beispiel (ungetestet, da hier kein Zugriff auf Excel) für Übertragung der gewählten _
Filtereinstellungen und er Werte in ein 2. Blatt. Ich hoffe, dass ich die Methoden und Eigenschaften der Objekte ohnr Editor korekt getroffen hab.
Sub Datentransfer
Dim wksAlle as Worksheet, wksAusgabe as Worksheet
Dim lngAlle as Long, lngAusgabe as Long
Dim SpalteAlle as Long, SpalteFilter as long
Dim objFilter as Filter, intFilter as Integer
Const TitelAlle as long = 5 'Titelzeile in Alle Werte
Set wksAlle = Worksheets("Alle_Werte")
Set wksAusgabe = Worlsheets("Werte_Eingabe")
'Daten im Ausgabeblatt löschen
wksAusgabe.Cells.Clear
With wksAlle
'Filter-Werte im Ausgabe-Blatt eintragen
lngAusgabe=1
wksAusgabe.Cells(lngAusgabe,1)="Filter:"
lngAusgabe=lngAusgabe + 1
wksAusgabe.Cells(lngAusgabe,1)="Spalte"
wksAusgabe.Cells(lngAusgabe,2)="Filter 1"
wksAusgabe.Cells(lngAusgabe,3)="Filter-Operator"
wksAusgabe.Cells(lngAusgabe,4)="Filter 2"
SpalteFilter= .Autofilter.Range.Column '1. Spalte des Autofilterbereichs
For intFilter = 1 to .Autofilter.Filters.Count
set objFilter = .Autofilter.Filters(intFilter)
if objFilter.On = True then
lngAusgabe=lngAusgabe + 1
'Spaltentitel eiensw gesetzten Filters übertragen
wksAusgabe.Cells(lngAusgabe,1)=.Cells(TitelAlle, SpalteFilter _
+ intFilter-1).Text
'Filter-Wwerte und ggf. Operator eintragen
wksAusgabe.Cells(lngAusgabe,2)=objFilter.Criteria1
if objFilter.Criteria2 "" then
wksAusgabe.Cells(lngAusgabe,3)=objFilter.Operator
wksAusgabe.Cells(lngAusgabe,4)=objFilter.Criteria2
end if
end if
Next
'Spaltentitel im Ausgabeblatt eintragen
lngAusgabe = lngAusgabe + 1
wksAusgabe.Cells(lngAusgabe, 1) = "PLZ"
wksAusgabe.Cells(lngAusgabe, 2) = "Name"
wksAusgabe.Cells(lngAusgabe, 3) = "Ausbildung"
wksAusgabe.Cells(lngAusgabe, 4) = "T1"
wksAusgabe.Cells(lngAusgabe, 5) = "achwas"
'gefilterte Daten (aus sichtbaren zeilen) übertragen
For lngAlles = Titelalle + 1 to .Cells(.rows.count, 2).End(xlUp).Row
If .Rows(lngAlles).Hidden=False then
lngAusgabe = lngAusgabe + 1
wksAusgabe.Cells(lngAusgabe,1 )= .Cells(lngAlles, 1)'"PLZ" - Spalte A
wksAusgabe.Cells(lngAusgabe,2) = .Cells(lngAlles, 2)'"Name" - Spalte B
wksAusgabe.Cells(lngAusgabe,3) = .Cells(lngAlles, 6)'"Ausbildung" - Spalte F
wksAusgabe.Cells(lngAusgabe,4) = .Cells(lngAlles, 7)'"T1" - Spalte G
wksAusgabe.Cells(lngAusgabe,5) = .Cells(lngAlles, 9)'"achwas" - Spalte J
End If
next
End With
End Sub