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

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

AW: Daten filtern

welga
AW: Daten filtern

Werner
Daten filtern

Erich
AW: Daten filtern

Werner

AW: Daten filtern

10.05.2010 13: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

AW: Daten filtern

10.05.2010 13: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

Daten filtern

10.05.2010 16: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

AW: Daten filtern

11.05.2010 07:10:01

Werner

Hallo Erich,
das ist genau das was ich gesucht habe, danke für die Hilfe.
Gruß Werner

Beliebteste Forumthreads (12 Monate)

Forumthread: Daten filtern

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

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread