ich habe ein super code gefunden mit dem man eine Tabelle mit Hilfe von einer Zelleingabe ( B bis E ) per Autofilter filtern kann.
Wie es immer so ist hat dieser noch ein kleinen "Fehler".
Bei Zahlen filtert er aber leider nur nach " entspricht " ich möchte aber gern auch bei Zahlen " enthält" benutzen.
https://www.herber.de/bbs/user/110835.xls
Dazu habe ich diese Sequenz
Criteria1:="=" & raZelle
in
Criteria1:="=*" & raZelle & "*"
oder in
Criteria1:="***"
geändert.Leider werden dann gar keine Zahlen mehr gefiltert.
Weiss jemand was ich ändern muss um auch Zahlenteile zu filtern?
mfg Thomas
der ganze code ist
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
'* 09.02.08,11.03.08,31.03.08 *
'* erstellt von Karin (Beverly), http://Excel-Inn.de*
'* Beverly_Forums@web.de *
Dim raBereich As Range
Dim raZelle As Range ' Variable für die Zelle als Range
' Wirkung des Codes auf Zeile 1 der Tabelle im Filterbereich zulassen
Set raBereich = Intersect(Target, Union(Range(Cells(1, ActiveSheet.AutoFilter.Range(1). _
Column), _
Cells(1, ActiveSheet.AutoFilter.Range(1).Column + ActiveSheet.AutoFilter.Filters.Count - _
1)), Range("D2")))
' Eingabe erfolgte im festgelegten Bereich
If Not raBereich Is Nothing Then
' Bildschirmaktualisierung aus
Application.ScreenUpdating = False
' Reaktion auf Eingabe abschalten
Application.EnableEvents = False
' Schleife über alle Zellen der Zeile 1 der Tabelle
For Each raZelle In raBereich
' Bezieht sich auf den Filterbereich
With ActiveSheet.AutoFilter.Range
' Eingabe wurde gelöscht
If raZelle = "" Or raZelle = "Suchbegriff eingeben" Then
' Autofilter für das betreffende Fald zurücksetzen
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter.Range(1). _
Column
' in die betreffende Zelle eintragen
raZelle = "Suchbegriff eingeben"
Else
' Suchkriterium ist eine Zahl
If IsNumeric(raZelle) Then
' !!!!!!!!!!! !! Autofilter für das betreffende Feld setzen, Filterkriterium "entspricht"
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter.Range(1). _
Column, Criteria1:="=" & raZelle
' Suchkriterium ist ein Datum
ElseIf IsDate(raZelle) Then
' Autofilter für das betreffende Feld setzen
Dim intOffset1 As Integer
Dim intOffset2 As Integer
Dim lngZeile2 As Long
If raZelle.Row = ActiveSheet.AutoFilter.Range.Rows(1).Row - 2 Then
intOffset1 = 0
intOffset2 = 1
lngZeile2 = 1
Else
intOffset1 = -1
intOffset2 = 0
lngZeile2 = -1
End If
' Filterung zwischen beiden Datumswerten falls beide Zellen ein Datum _
enthalten
If IsDate(raZelle.Offset(lngZeile2, 0)) Then
.AutoFilter Field:=raZelle.Column + 1 - ActiveSheet.AutoFilter. _
Range(1).Column, _
Criteria1:=">=" & raZelle.Offset(intOffset1, 0).Value2, _
Criteria2:="=" & raZelle.Value2, Criteria2:="