Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Anzeige
Inhaltsverzeichnis

Daten filtern

Forumthread: Daten filtern

Daten filtern
Werner
Hallo zusammen,
Ich möchte eine Auswertung aus einem Datenblatt ziehen.
Wenn ich im Blatt "Auswertung" in die Zelle A2 klicke, soll der Inhalt der Zelle auf dem Blatt "Zeitraum“ gesucht werden und alle Einträge, die in der Spalte A gefunden werden, im Blatt "Auswert" eingetragen werden. Aus dem Blatt Zeitraum brauche ich die Daten aus den Spalten A, C, J, K, M.
https://www.herber.de/bbs/user/69502.xls
Gruß Werner
Anzeige

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Daten filtern
10.05.2010 15:19:05
welga
Hallo,
schreibe folgendes in den Code vom Blatt Auswertung:
Sub worksheet_change(ByVal target As Range)
If Not Intersect(Range("a2"), target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Sheets("Auswert").UsedRange.ClearContents
a = Sheets("Auswertung").Cells(2, 1)
With Sheets("Zeitraum")
.Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
.Range(.Cells(1, 1), .Cells(1000, 18)).Select
Selection.AutoFilter
.Range("$A$1:$S$77").AutoFilter Field:=1, Criteria1:=a
.Columns("B:B").EntireColumn.Hidden = True
.Columns("D:I").EntireColumn.Hidden = True
.Columns("L:L").EntireColumn.Hidden = True
.Columns("N:S").EntireColumn.Hidden = True
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets("Auswert").Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Cells.EntireColumn.Hidden = False
Application.CutCopyMode = False
Selection.AutoFilter
.Rows("1:1").Delete Shift:=xlUp
Sheets("Auswert").Rows("1:1").Delete Shift:=xlUp
Sheets("Auswertung").Select
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End With
End If
Gruß
welga
Anzeige
AW: Daten filtern
10.05.2010 15:38:29
Werner
Hallo welga,
habe noch End Sub angefügt, geht aber doch nicht wirklich.
Beim einfachen klick passiert nichts und beim doppelklick und nach dem wechsen auf das Blatt kommt hier eine fehlermeldung. .Range(.Cells(1, 1), .Cells(1000, 18)).Select
ein weiteres mal kann ich die Auswertung nicht machen, da geschiet nichts.
Gruß Werner
Anzeige
Daten filtern
10.05.2010 18:21:57
Erich
Hi Werner,
probier mal diese Prozedur - die wirkt auf Klicken in Spalte A der Tabelle "Auswertung":

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range) ' im Code von "Auswertung"
Dim arrQ, arrE(), zz As Long, lngA As Long
If Target.Count > 1 Or Target.Row = 1 Or Target.Column > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub
With Sheets("Zeitraum")
arrQ = .Range(.Cells(2, 1), .Cells(.Rows.Count, 13).End(xlUp))
ReDim arrE(1 To 5, 1 To UBound(arrQ))
For zz = 1 To UBound(arrQ)
If arrQ(zz, 1) = Target Then
lngA = lngA + 1
arrE(1, lngA) = Target
arrE(2, lngA) = arrQ(zz, 3)
arrE(3, lngA) = arrQ(zz, 10)
arrE(4, lngA) = arrQ(zz, 11)
arrE(5, lngA) = arrQ(zz, 13)
End If
Next zz
End With
With Sheets("Auswert")
.UsedRange.ClearContents
If lngA > 0 Then
' ReDim Preserve arrE(1 To 5, 1 To lngA) ' ist nicht nötig
.Cells(2, 1).Resize(lngA, 5) = Application.Transpose(arrE)
.Columns("A:E").AutoFit
Else
MsgBox "Kein Treffer mit" & vbLf & Target
End If
End With
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Anzeige
AW: Daten filtern
11.05.2010 09:10:01
Werner
Hallo Erich,
das ist genau das was ich gesucht habe, danke für die Hilfe.
Gruß Werner
Anzeige
Anzeige
Live-Forum - Die aktuellen Beiträge
Datum
Titel
14.05.2026 13:31:09
14.05.2026 09:50:42
13.05.2026 19:14:18