Problem: Filter mit mehreren ToggleButtons

Guten Morgen miteinander

gerne würde ich im Excel mit Hilfe von Toggle buttons folgendes machen:

Es sollen mehrere toggles nebeneinander aufgereiht angezeigt werden. Beim drücken des 1. Buttons soll ein Teil der Daten gefiltert werden. z.B. all diejenigen Teile aus einer Liste mit ca 10 verschiedenen Währungen, die in USD sind.
Als nächster Schritt soll ein zweiter Button aktiviert werden können, ohne das die Auswahl des 1. Buttons aufgehoben wird. z.B sollen zusätzlich noch alle EUR Teile angezeigt werden.
Schlussendlich sollen also von ca 5000 Datensätzen nur die gewählten Währungen angezeigt werden (ca 200 Datensätze).

Abschliessend will ich mit einem "New Search" Button wieder alle Daten anzeigen und automatisch alle gewählten Buttons wieder inaktiv erscheinen lassen.

Ich habe dieses Problem versucht mit Makros zu lösen: Es fügt eine neue Spalte ein, schreibt eine 1 falls EUR bzw USD und anschliessend mit Autofilter die Nichtleeren filtern. Das Problem: Erstens ist es unschön, da man die "Arbeit" des Makros sehen kann und zweitens ist es viel zu langsam. Meine Frage daher: Gibt es mit VBA Möglichkeiten zur Lösung dieses Problems?

Vielen Dank für eure Inputs!

 

Hi Joe,

Reicht es Dir, wenn die Daten so sortiert werden, dass zuoberst in der Excel-Tabelle die EUR, USD, JPY oder sonstwas... oder EUR+USD, USD+CHF+HKD oder sonst was, stehen ?

Dann könnte ich Dir helfen, ob mit "Menü Daten > Sortieren", oder mit Buttons via VBA.

Komplizierte Darstellungen könnte man wohl auch erfinden, ich habe aber schlicht keine Lust dazu...

Gruss Urs

 

Hallo miteinander,

leider muss ich die nicht gewählten Währungen effektiv rausfiltern lassen und nicht nur sortieren. Hier ist mein sehr anfängerhafter Code, den ich verwendet habe:

Code:

Private Sub ToggleButton3_Click()
If ToggleButton3 = True Then
    Range("B15:ag15").Select
    Range("X15").Activate
    Selection.AutoFilter
    Range("V16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-19]=""EUR"",""EUR"","""")"
    Range("V16").Select
    Selection.AutoFill Destination:=Range("V16:V5000"), Type:=xlFillDefault
    Range("V16:V5000").Select
    Range("X16").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-2]="""",IF(RC[-1]="""","""",RC[-1]),RC[-2])"
    Range("X16").Select
    Selection.AutoFill Destination:=Range("X16:X5000"), Type:=xlFillDefault
    Range("X16:X5000").Select
    Selection.Copy
    Range("W16").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("X16:X5000").Select
    Application.CutCopyMode = False
    Selection.ClearContents
    Range("V16:V5000").Select
    Selection.ClearContents
    Range("B15:ag15").Select
    Range("X15").Activate
    Selection.AutoFilter
    Selection.AutoFilter Field:=22, Criteria1:="<>"
    Range("A1").Select
    Else
      Range("B15:ag15").Select
    Selection.AutoFilter
    Range("W16:W5000").Select
    Selection.Replace What:="eur", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
    Range("B15:ag15").Select
    Range("X15").Activate
    Selection.AutoFilter
    Selection.AutoFilter Field:=22, Criteria1:="<>"
    Range("A1").Select
End If
End Sub

Den entsprechenden Code habe ich auch für andere Währungen verwendet. Somit ist es möglich, dass zwei Buttons gleichzeitig gedrückt werden können und beide Filter angezeigt werden. Aber leider ist diese Methode bei ca. 5000 Datensätzen ziehmlich langsam und er springt während den Berechnungen immer nach rechts zu den Spalten AG z.b. Weiter habe ich das Problem, dass wenn ich den Button wieder deaktiviere zeigt er mir keine Daten mehr an, was eigentlich ja auch Sinn macht. Wenn ich allerdings wieder alle Daten angezeigt haben will muss ich nach der Abwahl des Buttons den Autofilter manuell entfernen und wieder setzen.

Beim Button für die "New Search" habe ich leider nichts wirklich verwendbares. Was er jedoch können sollte: Alle gedrückten Toggle Buttons deaktivieren und am Schluss alle Daten anzeigen.

Abere vielen Dank für eure Ideen und eure Hilfe

Gruss
Joe

 

Hi Joe Dee,

deinen Code könnte man sicher schneller machen. Z.B. könnte man schon mal die Bildschirmaktualisierung ausschalten und auf Select und verzichten.

Bis später,
Karin

 

Hi Joe Dee,

hier mal ein Versuch:

Code:

Private Sub ToggleButton3_Click()
    Dim loLetzte As Long
    loLetzte = ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
    Application.ScreenUpdating = False
    If ToggleButton3 Then
        Range("B15:AG15").AutoFilter
        Range("V16").FormulaR1C1 = "=IF(RC[-19]=""EUR"",""EUR"","""")"
        Range("V16").AutoFill Destination:=Range(Cells(16, 22), Cells(loLetzte, 22)), Type:=xlFillDefault
        Range("X16").FormulaR1C1 = "=IF(RC[-2]="""",IF(RC[-1]="""","""",RC[-1]),RC[-2])"
        Range("X16").AutoFill Destination:=Range(Cells(16, 24), Cells(loLetzte, 24)), Type:=xlFillDefault
        Range(Cells(16, 24), Cells(loLetzte, 24)).Copy
        Range("W16").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Application.CutCopyMode = False
        Union(Range(Cells(16, 22), Cells(loLetzte, 22)), Range(Cells(16, 24), Cells(loLetzte, 24))).ClearContents
        Range("X15").AutoFilter Field:=22, Criteria1:="<>"
    Else
        Range("B15:AG15").AutoFilter
        Range(Cells(16, 23), Cells(loLetzte, 23)).Replace What:="eur", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
        Range("X15").AutoFilter Field:=22, Criteria1:="<>"
    End If
    Application.ScreenUpdating = True
End Sub

Testen kann ich den Code nicht, da ich die Bedingungen in deiner Arbeitsmappe nicht kenne.

Für das Zurücksetzen des Autofilters kannst du diesen Code verwenden:

Code:

Private Sub CommandButton1_Click()
    Dim ooElement As OLEObject
    For Each ooElement In ActiveSheet.OLEObjects
        If ooElement.progID = "Forms.ToggleButton.1" Then ooElement.Object = False
    Next ooElement
    If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
End Sub

Bis später,
Karin