Filter sperren

[braesig]

Hallo,

ich habe ein Filterproblem meiner Excel Datei. 

Ich möchte eine Datei verschicken und in der Tabelle bereits Filter setzen. Nun soll der Nutzer allerdings bei einer Spalte die Möglichkeit haben zu filtern.
Wenn ich mit einem Blattschutz arbeite, sperrt er mir aber immer die gesamte Zeile - also alle Filter. Und das obwohl ich die Zelle richtig formatiert habe und nicht gesperrt habe.

An meinem konkreten Beispiel:

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B	C	D	E
1	Artikel	Lagerung	Einkäufer	EK	VK
2	Eis	TK	Hr. Meier	2,00 €	5,00 €
3	Pizza	TK	Hr. Mann	1,00 €	4,00 €
4	Kuchen	Regal	Fr. Schulz	3,00 €	6,00 €
5	Kekse	Regal	Hr. Seppel	1,50 €	7,00 €
6	Kuchen 2	Regal	Fr. Schulz	2,50 €	6,70 €

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Die Lagerung (Spalte B) soll bereits auf "Regal" vorgefiltert sein. Diese Filterung soll von keinem Nutzer aufgelöst werden.
Allerdings soll der Nutzer in der Spalte C nach dem Namen der Einkäufer filtern können. 
Die Spalten A, D, E sollen ebenfalls nicht mit dem Filter genutzt werden können.

Die Testdatei ist anbei.

Könnt ihr mir ungefähr folgen?

Danke für eure Hilfe.

[Kuwer]

Hallo Flynn,

beim Blattschutz hakst Du die Option Autofilter verwenden an.
Aber davor blendest Du mit folgendem Makro die unerwünschten Filterdropdowns aus:

Code:

Sub aaa()
  Dim i As Long, lngSpalte As Long
  lngSpalte = 3 'Spalte des AF, die einzig filterbar bleiben soll
  With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
      If .Filters(i).On Then
        If .Filters(i).Count = 2 Then
          .Range.AutoFilter field:=i, Criteria1:=.Filters(i).Criteria1, Operator:=.Filters(i).Operator, Criteria2:=.Filters(i).Criteria2, visibledropdown:=i = lngSpalte
        Else
          .Range.AutoFilter field:=i, Criteria1:=.Filters(i).Criteria1, visibledropdown:=i = lngSpalte
        End If
      Else
        .Range.AutoFilter field:=i, visibledropdown:=i = lngSpalte
      End If
    Next i
  End With
End Sub

Dieses Makro kann ja in einer anderen Datei stehen, z.B. in der persönlchen Makroarbeitsmappe.

Gruß Uwe

[Cadmus]

Hallo,
wenn ich nicht möchte, dass Daten eingesehen werden, stelle ich sie auch nicht zur Verfügung.

Ich würde die relevanten Daten in eine neue Datei filtern. Mit einem aktuellerem Office als 2010 wäre das mit Power Query mit ein paar Klicks erledigt.

[RPP63]

Moin!
Wobei dazu ja nun kein PQ notwendig ist.
Ich filtere Spalte B wie gewünscht …
und kopiere alle Zellen in eine neue Datei.
Excel kopiert nämlich nur die sichtbaren Zellen.

Um nun nur einen Filterdropdown zur Verfügung zu haben …
markiere ich Spalte C in der ungefilterten neuen Tabelle und wähle Daten → Filtern

Gruß Ralf

[braesig]

Danke schön für den Makro - das probiere ich gleich mal aus.

Ich möchte zu einem späteren Zeitpunkt die Informationen wieder einblenden, daher kann ich die Daten auch nicht rauskopieren. Das ist ja jetzt eine vereinfachte Darstellung

Danke - ich melde mich bei Problemen einfach noch mal.

[Kuwer]

Hi,

Danke schön für den Makro - das probiere ich gleich mal aus.

nimm dann besser folgendes Makro:

Code:

Sub aac()
  'Kuwer 20210116
  Dim i As Long, lngSpalte As Long
  lngSpalte = 3 'Spalte des AF, die einzig filterbar bleiben soll
  With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
      'lngSpalte = i 'so werden alle DropDowns wieder eingeblendet, wenn aktiviert
      If .Filters(i).On Then
        Select Case .Filters(i).Count
          Case 0
            'hier wäre der Ort für ein Datumsarray, das aber nicht gelesen werden kann
            '.Range.AutoFilter Field:=i, _
                           Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=i = lngSpalte
          Case 1
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                    VisibleDropDown:=i = lngSpalte
          Case 2
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                           Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=i = lngSpalte
          Case Else
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                           Operator:=.Filters(i).Operator, _
                    VisibleDropDown:=i = lngSpalte
        End Select
      Else
        .Range.AutoFilter Field:=i, _
                VisibleDropDown:=i = lngSpalte
      End If
    Next i
  End With
End Sub

Gruß Uwe

[braesig]

Hallo,

danke @Uwe das hat schon mal super geklappt. 

Wie muss ich den Code ändern, damit ich noch eine zweite Spalte bzw. einen zweiten Filter einblende. 

Kann ich in Spalte 4 noch eine Spalte hinzufügen? Mit Leerzeichen, Komma und Semikolon bin ich nicht weitergekommen.

Code:

Sub aac()
  'Kuwer 20210116
  Dim i As Long, lngSpalte As Long
  lngSpalte = 3 'Spalte des AF, die einzig filterbar bleiben soll
  With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
      'lngSpalte = i 'so werden alle DropDowns wieder eingeblendet, wenn aktiviert
      If .Filters(i).On Then
        Select Case .Filters(i).Count
          Case 0
            'hier wäre der Ort für ein Datumsarray, das aber nicht gelesen werden kann
            '.Range.AutoFilter Field:=i, _
                           Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=i = lngSpalte
          Case 1
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                    VisibleDropDown:=i = lngSpalte
          Case 2
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                           Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=i = lngSpalte
          Case Else
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                           Operator:=.Filters(i).Operator, _
                    VisibleDropDown:=i = lngSpalte
        End Select
      Else
        .Range.AutoFilter Field:=i, _
                VisibleDropDown:=i = lngSpalte
      End If
    Next i
  End With
End Sub

Danke

[Kuwer]

Hallo,

für eine oder mehrere Spalte(n):

Code:

Sub aad()
  'Kuwer 20210118
  Dim i As Long, varSpalten() As Variant
  varSpalten = Array(3, 4) 'Spalten des AF, die filterbar bleiben sollen
  With ActiveSheet.AutoFilter
    For i = 1 To .Filters.Count
      'varSpalten = Array(i) 'so werden alle DropDowns wieder eingeblendet, wenn aktiviert
      If .Filters(i).On Then
        Select Case .Filters(i).Count
          Case 0
            'hier wäre der Ort für ein Datumsarray, das aber nicht gelesen werden kann
            '.Range.AutoFilter Field:=i, _
                          Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=InStr(1, Join(varSpalten) & " ", i & " ")
          Case 1
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                    VisibleDropDown:=InStr(1, Join(varSpalten) & " ", i & " ")
          Case 2
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                          Operator:=.Filters(i).Operator, _
                          Criteria2:=.Filters(i).Criteria2, _
                    VisibleDropDown:=InStr(1, Join(varSpalten) & " ", i & " ")
          Case Else
            .Range.AutoFilter Field:=i, _
                          Criteria1:=.Filters(i).Criteria1, _
                          Operator:=.Filters(i).Operator, _
                    VisibleDropDown:=InStr(1, Join(varSpalten) & " ", i & " ")
        End Select
      Else
        .Range.AutoFilter Field:=i, _
                VisibleDropDown:=InStr(1, Join(varSpalten) & " ", i & " ")
      End If
    Next i
  End With
End Sub

Gruß Uwe