Einträge nach AutoFilter auslesen

Liebe Excel-Gemeinde,
ich habe eine Tabelle mit 2 Tabellenblättern. Auf Blatt 1 befinden sich Datensätze in 3 Spalten. Diese werden mit Hilfe eines Autofilters gefiltert. Ich möchte nun auf Blatt 2 nur die unterschiedlichen Einträge der jeweiligen Spalte auslesen, die auch wirklich angezeigt werden. Das heißt, wird auf Blatt 1 nach einem bestimmten Begriff in Spalte 1 gefiltert, sollen auf Blatt 2 nur noch die Einträge der Spalten 1, 2 und 3 angezeigt werden, die für den Nutzer im Zuge der Filterung auch wirklich noch sichtbar sind. Ist das mit Hilfe einer Formel umsetzbar?
Ich habe eine Beispieldatei angefertigt. Der Autofilter muss leider aktiv bleiben.
https://www.herber.de/bbs/user/46795.xls
Herzlichen Dank für Eure Hilfe und schöne Grüße
Tommi

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Tommi,
Formellösung ist bei der komplexen Auswertung kaum noch möglich bzw. erforderdert etliche Hilfsspalten und die Nutzung einer nicht mehr veröffentlichten Funktion aus Excel 4.0.
Einfacher ist hier die Verwendung eines Makros, dass die sichtbaren Daten von Tab1 nach Tab2 überträgt unddabei doppelte Einträge verhindert.
Gruß
Franz


Sub Von1nach2()
'Überträgt die sichtbaren Datenzeilen von Blatt 1 nach Blatt 2 _
wobei keine doppelten Einträge in den Spalten übertragen werden
Dim wksQ As Worksheet, wksZ As Worksheet
Dim Zeile1 As Long, Spalte As Integer
Dim arrZeiSpa2(1 To 3, 1 To 2) As Integer
Set wksQ = Worksheets("Quelle")
Set wksZ = Worksheets("Ziel")
With wksZ
'Startzeile für Einträge im Zielblatt
Zeile2Start = 2
arrZeiSpa2(1, 1) = Zeile2Start 'Stadt
arrZeiSpa2(2, 1) = Zeile2Start 'Name
arrZeiSpa2(3, 1) = Zeile2Start 'deutsch/englisch
'Spalten für die Einträge im Blatt 2
arrZeiSpa2(1, 2) = 2 'Stadt
arrZeiSpa2(2, 2) = 3 'Name
arrZeiSpa2(3, 2) = 4 'deutsch/englisch
'vorhandene Daten löschen
.Range(.Cells(Zeile2Start, arrZeiSpa2(1, 2)), _
.Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, arrZeiSpa2(3, 2))).ClearContents
For Zeile1 = 2 To wksQ.Cells(wksQ.Rows.Count, 1).End(xlUp).Row
If wksQ.Rows(Zeile1).Hidden = False Then
'Einträge in Quellzeile abarbeiten
For Spalte = 1 To 3
'Prüfung ob Eintrag schon vorhanden
If Application.WorksheetFunction.CountIf(.Range(.Cells(Zeile2Start, _
arrZeiSpa2(Spalte, 2)), .Cells(arrZeiSpa2(Spalte, 1), arrZeiSpa2(Spalte, 2))), _
wksQ.Cells(Zeile1, Spalte).Value) = 0 Then
'Wert eintragen
.Cells(arrZeiSpa2(Spalte, 1), arrZeiSpa2(Spalte, 2)).Value = _
wksQ.Cells(Zeile1, Spalte).Value
'Zeilenzähler für Spalte in Zieltabelle erhöhen
arrZeiSpa2(Spalte, 1) = arrZeiSpa2(Spalte, 1) + 1
End If
Next
End If
Next
End With
End Sub

Sub Von1nach2() 'Überträgt die sichtbaren Datenzeilen von Blatt 1 nach Blatt 2 _ wobei keine doppelten Einträge in den Spalten übertragen werden Dim wksQ As Worksheet, wksZ As Worksheet Dim Zeile1 As Long, Spalte As Integer Dim arrZeiSpa2(1 To 3, 1 To 2) As Integer Set wksQ = Worksheets("Quelle") Set wksZ = Worksheets("Ziel") With wksZ 'Startzeile für Einträge im Zielblatt Zeile2Start = 2 arrZeiSpa2(1, 1) = Zeile2Start 'Stadt arrZeiSpa2(2, 1) = Zeile2Start 'Name arrZeiSpa2(3, 1) = Zeile2Start 'deutsch/englisch 'Spalten für die Einträge im Blatt 2 arrZeiSpa2(1, 2) = 2 'Stadt arrZeiSpa2(2, 2) = 3 'Name arrZeiSpa2(3, 2) = 4 'deutsch/englisch 'vorhandene Daten löschen .Range(.Cells(Zeile2Start, arrZeiSpa2(1, 2)), _ .Cells(.Cells.SpecialCells(xlCellTypeLastCell).Row, arrZeiSpa2(3, 2))).ClearContents For Zeile1 = 2 To wksQ.Cells(wksQ.Rows.Count, 1).End(xlUp).Row If wksQ.Rows(Zeile1).Hidden = False Then 'Einträge in Quellzeile abarbeiten For Spalte = 1 To 3 'Prüfung ob Eintrag schon vorhanden If Application.WorksheetFunction.CountIf(.Range(.Cells(Zeile2Start, _ arrZeiSpa2(Spalte, 2)), .Cells(arrZeiSpa2(Spalte, 1), arrZeiSpa2(Spalte, 2))), _ wksQ.Cells(Zeile1, Spalte).Value) = 0 Then 'Wert eintragen .Cells(arrZeiSpa2(Spalte, 1), arrZeiSpa2(Spalte, 2)).Value = _ wksQ.Cells(Zeile1, Spalte).Value 'Zeilenzähler für Spalte in Zieltabelle erhöhen arrZeiSpa2(Spalte, 1) = arrZeiSpa2(Spalte, 1) + 1 End If Next End If Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Einträge nach AutoFilter auslesen

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread