Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1156to1160
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

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
Anzeige
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
Anzeige
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
Anzeige
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)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige