Office: Einfacher Filter über Makro gesucht

Hallo,

Ich bräuchte einen Filter, der alle Zeilen ausblendet, bis auf die mit der Zahl 4 oder 5 drin. Bis jetzt würds ja noch gehen, aber er soll mir nicht nur die betroffene Zeile ausgeben, sondern auch die danach folgende Zeile.
Ich fürchte, hier komm ich mit den normalen Filtern nicht weiter und brauche ein entsprechendes Makro.
Kann mir bitte jemand helfen oder am besten den entsprechenden VBA Code entwerfen, da ich noch totaler 'Anfänger in VBA-Sachen bin.

Vielen Dank im Voraus...


Mit freundlichen Grüßen
Mad

 

Hi,

steht der Wert 4 bzw. 5 irgendwo in der Zeile oder immer in eine bestimmten Spalte? Und wenn ja - in welcher?

Bis später,
Karin

 

Hallo Karin,

schon einmal Danke für Dein interesse!
Ich denke ein Bild sagt mehr als viele Worte, von daher habe ich einen kleinen Ausschnitt aus meiner Tabelle mitgeschickt.
Oben siehst du die Kalenderwochen und ich möchte in jeder Spalte einen Filter installieren, der mir alle Zeilen (mit der dazugehörigen Zeile da drunter) anzeigt, wo entweder eine 4 oder 5 in der Spalte enthalten ist.
In der korrespondierenden Zeile darunter befinden sich die Zahlen 1 -3 (die Farben).
Ich habe bereits ein Makro zusammengebastelt, welches die Zahlen 1 - 5 einer Farbe zuweist -Ich habe hier nur 4 und 5 der Übersicht halber nicht umgefärbt.
Wenn Du weitere Fragen hast -immer raus damit. Bin ja jetzt schon glücklich, dass mir jemand helfen will :-D

 

Hi,

eine hochgeladene Beispielmappe sagt 1000 mal mehr als ein Bild, weil selbst Excel2010 kein Bild in eine Excel-Tabelle umwandeln kann. Das würde Arbeit beim Nachbau ersparen, wobei außerdem ein Nachbau nie genau dem Original entsprechen kann.

Verwende ein Kombinationsfeld aus der Formular-Symbolleiste als "Filterauswahl" und weise ihm dieses Marko (in einem allgemeinen Modul) zu:

Code:

Sub Filtern()
    Dim lngZeile As Long
    Dim wshTab As Worksheet
    Dim bytVorhanden As Byte
    Dim shaShape As Shape
    Set wshTab = ActiveSheet
    With wshTab.Shapes(wshTab.Application.Caller)
        Application.ScreenUpdating = False
        wshTab.Rows("4:200").Hidden = False
        If wshTab.Range(.ControlFormat.ListFillRange).Cells(.ControlFormat.ListIndex) <> "Alle" Then
            wshTab.Rows("4:200").Hidden = False
            For lngZeile = 4 To 200
                On Error Resume Next
                bytVorhanden = Application.Match(wshTab.Range(.ControlFormat.ListFillRange).Cells(.ControlFormat.ListIndex), wshTab.Range("A" & lngZeile & ":S" & lngZeile), 0)
                On Error GoTo 0
                If bytVorhanden <> 0 Then
                    lngZeile = lngZeile + 1
                Else
                    Rows(lngZeile).EntireRow.Hidden = True
                End If
                bytVorhanden = 0
            Next lngZeile
        End If
        Application.ScreenUpdating = True
    End With
    For Each shaShape In ActiveSheet.Shapes
        shaShape.ControlFormat.ListIndex = 0
    Next shaShape
    Set wshTab = Nothing
End Sub

Die Zeilen 4:200 musst du an deine Bedingungen anpassen, ebenso den Beginn und das Ende der For-Schleife.
Als Eingabebereich für das Kombinationsfeld verwendest du 3 Zellen einer (beliebigen) Spalte, in denen die Werte: Alle, 4 und 5 stehen.

Kopiere dann dieses Steuerelement in jede Spalte.

Sobald du in einem der 28 Steuerelemente 4 oder 5 auswählst, werden alle Zeilen ab Zeile 4 bis 200 ausgeblendet, in denen nicht in einer beliebigen Spalte der ausgewählte Wert steht. Wählst du "Alle" aus, werden alle Zeilen wieder eingeblendet.

Bis später,
Karin

 

Hallo Karin,

ok, du hast natürlich völlig recht mit der Beispiel-Mappe -Es sind nur sensible Firmendaten und ich neu in dem Unternehmen :-?
Auf jeden Fall schon mal vielen, vielen Dank für das Programm -Doch so sehr ich gerade rum probiere, ich bekomms einfach nicht zum laufen.
Ich habe jetzt eine kleine Excel-Tabelle hochgeladen -ein Ausschnitt aus der großen. Könntest du mir nicht kurz für eine Spalte eine Kombi-Box mit Filter einrichten -Ich denke (hoffe) das übertragen auf die anderen Spalten schaffe ich dann alleine
Könntest du mir auch noch sagen, wie ich es schaffe, dass mein Makro dauerhaft aktiv ist und nicht immer erst aktiviert werden muss?
Das wär super, super nett von dir -und ich könnte mal ein wenig punkten hier :-D

P.s.: Ist es nicht möglich 4 und 5 als ein Filterkriterium zusammenzufassen, so dass man quasi auf einen Knopf drückt (Filter an) und es werden alle Zeilen angezeigt, die 4 oder 5 enthalten (natürlich immer noch mit der jeweiligen Zeile darunter)?

 

Hi,

um die Abfrage bezüglich des Aktivierens der Makros zu umgehen, musst du ein digitales Zertifikat erstellen. Auf keinen Fall jedoch darfst du die Markosicherheit auf Niedrig stellen - dann kommt zwar auch keine Abfrage mehr, aber es könnten auch Dateien geöffnet werden, die schädliche Makros enthalten und das sollte auf keinen Fall zugelassen werden.

Da deine Arbeitsmappe anders aufgebaut ist, sieht der Code jetzt natürlich auch teilweise anders aus.

Bis später,
Karin

 

Hallo Karin,

erst einmal vielen, vielen Dank!!! -Das sieht schon sehr nach dem aus, was ich suche... Aber auch auf die Gefahr hin, dass Du die Hände über dem Kopf zusammenschlägst und denkst "Der kann ja gar nix":
Wie mache ich das denn jetzt, dass jeder Filter nur die entsprechende Spalte filtert, über die er steht? Momentan filtert ja jeder Filter die gesamte Tabelle

Grüße
Mad

 

Hi Mad,

Code:

Sub Filtern()
    Dim lngZeile As Long
    Dim wshTab As Worksheet
    Dim shaShape As Shape
    Set wshTab = ActiveSheet
    With wshTab.Shapes(wshTab.Application.Caller)
        Application.ScreenUpdating = False
        wshTab.Rows("5:200").Hidden = False
        If .ControlFormat.ListIndex <> 1 Then
            For lngZeile = 5 To 56
                If Cells(lngZeile, .TopLeftCell.Column) = 4 Or Cells(lngZeile, .TopLeftCell.Column) = 5 Then
                    lngZeile = lngZeile + 1
                Else
                    Rows(lngZeile & ":" & lngZeile + 1).EntireRow.Hidden = True
                    lngZeile = lngZeile + 1
                End If
            Next lngZeile
        End If
        Application.ScreenUpdating = True
        If .ControlFormat.ListIndex = 1 Then
            For Each shaShape In ActiveSheet.Shapes
                shaShape.ControlFormat.ListIndex = 0
            Next shaShape
        End If
    End With
    Set wshTab = Nothing
End Sub

Bis später,
Karin

 

Heyyy Karin,

der absolute Hammer -Danke, Danke, Danke dafür!!! Genau das, was ich wollte...
Eine Kleinigkeit hätte ich jetzt aber doch noch:
Ich habe jetzt einfach den Filter-Button kopiert und in die eigentliche Tabelle eingefügt, den VBA-Text als Makro eingegeben und dem Button zugewiesen und die Kriterien in eine Spalte geschrieben und ebenfalls zugewiesen. Ich habe die Range großzügig verlängert (auf 400) und das Filtern klappt wunderbar, aber wenn ich wieder auf "alle" klicke, zeigt er mir zwar wieder alle an, aber er gibt mir einen Runtime Error 438 "Object doesn't support this property or method" aus.

Der Debug-Modus zeigt dann folgendes:

Sub Filtern()
Dim lngZeile As Long
Dim wshTab As Worksheet
Dim shaShape As Shape
Set wshTab = ActiveSheet
With wshTab.Shapes(wshTab.Application.Caller)
Application.ScreenUpdating = False
wshTab.Rows("4:400").Hidden = False
If .ControlFormat.ListIndex <> 1 Then
For lngZeile = 4 To 400
If Cells(lngZeile, .TopLeftCell.Column) = 4 Or Cells(lngZeile, .TopLeftCell.Column) = 5 Then
lngZeile = lngZeile + 1
Else
Rows(lngZeile & ":" & lngZeile + 1).EntireRow.Hidden = True
lngZeile = lngZeile + 1
End If
Next lngZeile
End If
Application.ScreenUpdating = True
If .ControlFormat.ListIndex = 1 Then
For Each shaShape In ActiveSheet.Shapes
shaShape.ControlFormat.ListIndex = 0 Next shaShape
End If
End With
Set wshTab = Nothing
End Sub

Ich weiß nicht, ob es z.B. was damit zu tun hat, dass links noch ein paar Spalten dazu gekommen sind?!


Auf jeden Fall bin ich schon einmal überglücklich und weiß gar nicht was ich sagen soll. Toll, dass es noch Menschen gibt, die einem so uneigennützig helfen!


Beste Grüße
Mad

 

Hi Mad,

ich nehme an, durch das Kopieren in eine andere Arbeitsmappe wurde das Kombinationsfeld in einen anderen Objekttyp umgewandelt, den man anders ansprechen muss. Das kann ich leider nicht überprüfen, da ich die Arbeitsmappe nicht vorliegen habe.
Deshalb sehe ich als einzige Möglichkeit, dass du ein neues Kombinationsfeld erstellst, ihm das Makro und den Eingabebereich zuweist und dieses dann entsprechend kopierst.

Du musst darauf achten, dass sich die linke Kante jedes Kombinationsfeldes innerhalb der betreffenden Spalte befindet (also ein klein wenig rechts vom linken Spaltenrand), weil der Code sich auf die Position der linken Kante (bzw. oberen linke Ecke) des Kombinationsfeldes bezieht um zu erkennen, in welcher Spalte das Kombinationsfeld aktiviert wurde.

Bis später,
Karin

 

Hallo Karin,

irgendwie ist dein Kombinationsfeld anders als das, was ich erstelle. Ich find noch nicht mal die Option "Makro zuweisen". Leider ist meine Version auch auf Englisch, was die Sache nicht unbedingt einfacher macht...
Bevor ich mich jetzt wieder einer "Ich schmeiß den Computer an die Wand"-Stimmung hingebe, habe ich eine Tabelle mitgeschickt, die zumindest keine Daten erhält, aber dafür mein Problem :-)
Könntest du mir auch sagen, wo genau der Fehler liegt, da ich das ganze auch noch auf ander Tabellen übertragen muss.

Vielen Dank im Voraus...


Beste Grüße
Mad

 

Hi Mad,

mache einen Rechtsklick auf das Kombinationsfeld -> Makro zuweisen und wähle dort "Filtern" aus.

Der Fehler kommt deshalb, weil du einen (oder mehrere) Kommentar(e) im Tabellenblatt hast. Ändere diese Zeile:

Code:

                If shaShape.Type = msoFormControl _
                    Then shaShape.ControlFormat.ListIndex = 0

Bis später,
Karin

 

Heyy Karin

zu Punkt a) Wenn ich eine Combobox auf die Excel-Tabelle lege, habe ich mit der rechten Maustaste ein Menü, was folgende Möglichkeiten enthält:
Cut
Copy
Paste
Properties
View Code
ComboBox Object -> Edit
Grouping
Order
Format Control

Leider aber keine Makrozuweisung, wie bei deiner Box. Letztendlich ist es auch gerade nicht so wichtig, denn ich kann ja einfach deinen nehmen, was mich zu Punkt b) bringt:
JJJJJJJJAAAAAAAAAAAAAAAAA, es funktioniert einwandtfrei!!!!!
Danke, Danke, Danke :mrgreen:
Genau das wollte ich -Super Arbeit und danke für das Engagement!

Ich hätte jetzt nur noch eine Frage zu der permanenten Aktivierung des Farbzuweisungs-Makros. Du sagtest ich soll ein Digitales Zertifikat erstellen. Nun liegt diese Datei auf dem Firmen-Server, also im Netzwerk und alle sollen Zugriff darauf haben. Das Zertifikat gilt doch aber nur dann, wenn ich an meinem Rechner die Excel-Datei öffne oder irre ich mich?

Beste Grüße
Mad

 

Hi Mad,

zu a) ich nehme an, dass die Eigenschaft "View Code" die ist die du suchst - das musst du halt mal testen, ich habe kein englisches Excel. Wenn du da drauf gehst, sollte dir der Makroname angezeigt in einem Auswahlfenster angezeigt werden.

zu b) soweit mir bekannt ist, muss das Zertifikat auf jedem Nutzerrechner beim ersten Öffnen akzeptiert werden.

Bis später,
Karin