"Klickfilter" die zweite
02.07.2016 12:31:03
MB12
den neuen Thread habe ich eröffnet, um nicht nochmal den alten von Louis durcheinander zu bringen.
KlausF hat eine richtig schöne und brauchbare Filtermöglichkeit eingebracht:
Zuerst in J1 auf ON stellen, danach eine beliebige Ziffer in A anklicken.
Diese Art der Filterung gilt für alle Spalten. Eine gefilterte Spalte wird
durch einen gelben Kopf dargestellt. Ein Klick in den Kopf und der Filter
wird zurückgesetzt. Wenn J1 auf OFF findet keine Filterung statt.
https://www.herber.de/bbs/user/106660.xls
..
Da ich diese Lösung mehrfach einsetzen könnte, habe ich es getestet. Funktioniert leider bei mir nicht bei Zahlen (nichts geändert, Format Standard, s. unten) mit Nachkommastellen.
Antworten auf Nachfrage:
KlausF:
.also bei mir funktioniert das auch mit Nachkommastellen.
Zellenformat steht auf Standard, wie Spalte F.
Mit "Zahl mit 2 Nachkommastellen" funktioniert es auch nicht. Komisch
und
Hallo! Der Fehler liegt wohl an der internen englischen Sprache von Excel. Für die Sortierung _
_
sollte das Komma durch einen Punkt ersetzt werden (beim Criterium). Sieht dann in etwas so aus. _
Criteria1:=Replace(deinwert, ",", ".")
siehe auch hier
https://www.herber.de/forum/archiv/940to944/942636_VBA_Autofilter_nimmt_keine_Komma_zahl.html
Der Code nach dem Anpassen behebt das Problem noch nicht (aber das könnte an meinen beschränkten VBA-Kenntnissen liegen):
Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngF As Range
Dim rngFS As Range
Dim lRow As Long
Dim lCol As Long
Set rngF = ActiveSheet.AutoFilter.Range
Set rngFS = ActiveSheet.Range("FilterStatus")
lCol = rngF.Columns(1).Column - 1
lRow = rngF.Columns(1).Row
If Target.Count > 1 Then GoTo exitHandler
If Target.Address = rngFS.Address Then
If rngFS.Value = "On" Then
rngFS.Value = "Off"
Call ShowArrows(lRow, lCol)
Else
rngFS.Value = "On"
Call HideArrows(lRow, lCol)
End If
rngFS.Offset(1, 0).Activate
End If
If UCase(rngFS.Value) = "ON" Then
If Not Intersect(Target, rngF) Is Nothing Then
If Target.Row > lRow Then
'rngF.AutoFilter Field:=Target.Column - lCol, _
Criteria1:=Target.Value
'*******ersetzt durch**************:
rngF.AutoFilter Field:=Target.Column - lCol, _
Criteria1:=Replace(Target.Value, ",", ".")
Cells(lRow, Target.Column).Interior.ColorIndex = 36
ElseIf Target.Row = lRow Then
rngF.AutoFilter Field:=Target.Column - lCol
Cells(lRow, Target.Column).Interior.ColorIndex = xlNone
End If
End If
End If
exitHandler:
Exit Sub
End Sub
Sub HideArrows(lRow As Long, lCol As Long)
Dim c As Range
Dim i As Integer
i = Cells(lRow, lCol + 1).End(xlToRight).Column
Application.ScreenUpdating = False
For Each c In Range(Cells(lRow, lCol + 1), Cells(lRow, lCol + i))
c.AutoFilter Field:=c.Column, _
Visibledropdown:=False
c.Interior.ColorIndex = xlNone
Next
Application.ScreenUpdating = True
End Sub
Sub ShowArrows(lRow As Long, lCol As Long)
Dim c As Range
Dim i As Integer
i = Cells(lRow, lCol + 1).End(xlToRight).Column
Application.ScreenUpdating = False
For Each c In Range(Cells(lRow, lCol + 1), Cells(lRow, lCol + i))
c.AutoFilter Field:=c.Column, _
Visibledropdown:=True
c.Interior.ColorIndex = xlNone
Next
Application.ScreenUpdating = True
End Sub
Habe ich etwas falsch gemacht bzw. müsste man noch etwas ändern?
Zusatzfrage: Siehe Bemerkung von Klaus: Mit "Zahl mit 2 Nachkommastellen" funktioniert es auch nicht. Komisch
Ließe sich das auch beheben?
Nicht zu vergessen: Herzlichen Dank an Klaus und Matthias.
Gruß, Margarete