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