none
Thema: VBA Excel 2010 Listobject Autofilter. Wie bekomme ich heraus ob eine Sortierung in der Spalte aktive ist? RRS feed

  • Frage

  • Hallo Leute

    ich möchte alle Autofiltereinstellungen abspeichern. Habe das auch schon mit eurer Hilfe ein Stück hinbekommen.  Wie bekomme ich nun heraus, ob eine Spalte sortiert ist?  Gibt es da ein Befehle der mir sagt ob  in der Spalte  eine  Sortierung aktive ist  oder nicht?

    Habt Ihr vielleicht eine Code Beispiel?

    Danke für eure Hilfe.

    Ferby

    Donnerstag, 9. April 2015 08:42

Antworten

  • Huppsala, Du willst auf den Autofilter des ListObjects zugreifen, das geht natürlich ein bißchen anders:

    Sub Test()
      Dim L As ListObject
      Dim AF As AutoFilter
      Dim Fs As Filters
      Dim F As Filter
      Set L = ActiveSheet.ListObjects(1)
      Set AF = L.AutoFilter
      Set Fs = AF.Filters
      For Each F In Fs
        If F.On Then
          'Gesetzt
        End If
      Next
    End Sub

    Allerdings gilt alles andere was ich gesagt habe unverändert auch dafür.

    Andreas.

    • Als Antwort markiert Ferby_ Mittwoch, 9. März 2016 09:08
    Donnerstag, 9. April 2015 16:23

Alle Antworten

  • Habe das auch schon mit eurer Hilfe ein Stück hinbekommen. 

    Ich geb Dir mal 'nen Tip: Bevor Du sowas anfängst, google einfach mal oder frag, das spart Arbeit und Frust, denn man ist (fast) nie der erste der sich daran probiert.

    Was mich zu gute Nachricht, schlechte Nachricht bringt:

    Gute Nachricht:
    Das geht da kommst Du via ActiveSheet.AutoFilter.Filters dran, wenn .On dann ist er gesetzt.

    Schlechte Nachricht:
    Du bekommst nicht alle Filtereinstellungen und kannst sie auch nicht 1:1 reproduzieren... tja, da fehlt halt noch einiges im VBA-Objectmodell.

    Gute Nachricht:
    Du kannst statt dessen die Ansicht abspeichern und wiederherstellen, das bringt Dir auch einen Autofilter wieder.

    Der Code für beides ist unten dran.

    Andreas.

    Sub SaveAutofilter(ByRef FilterArray As Variant, Optional ByVal W As Worksheet = Nothing)
      'Save the filter settings of an auto filter (see SaveView as alternative)
      Dim i As Long
      Dim f As Filter, R As Range
      Dim NotHeading As Boolean
      Dim Dict As Object 'Scripting.Dictionary
    
      If W Is Nothing Then Set W = ActiveSheet
      If Not W.AutoFilterMode Then
        FilterArray = Array()
        Exit Sub
      End If
      With W.AutoFilter
        ReDim FilterArray(1 To .Filters.Count, 1 To 3)
        On Error GoTo Errorhandler
        For Each f In .Filters
          i = i + 1
          With f
            If .On Then
              FilterArray(i, 1) = .Criteria1
              If IsArray(FilterArray(i, 1)) Then
                FilterArray(i, 2) = .Operator
              Else
                If .Operator Then
                  FilterArray(i, 2) = .Operator
                  FilterArray(i, 3) = .Criteria2
                End If
              End If
            End If
          End With
    NextFilter:
        Next
        Exit Sub
    
    Errorhandler:
        Select Case f.Operator
          Case xlBottom10Percent, xlBottom10Items, xlTop10Percent, xlTop10Items
            'BUG: 'The .Criteria1 is not a valid setting for this operator
            FilterArray(i, 2) = Empty
            Resume NextFilter
          Case 7 'xlFilterValues
            'BUG: The .Criteria2 did not return the dates!
            Set Dict = CreateObject("Scripting.Dictionary")
            'Read the values from the visible cells, ignore the heading
            For Each R In Intersect(.Range.Columns(i), _
                .Range.Columns(i).SpecialCells(xlCellTypeVisible))
              If NotHeading Then
                'Store the column number
                Dict.Add Dict.Count, i
                'Store the international date (Don't use VBA.Format!)
                Dict.Add Dict.Count, _
                  Month(R.Value2) & "/" & Day(R.Value2) & "/" & Year(R.Value2)
              Else
                NotHeading = True
              End If
            Next
            FilterArray(i, 2) = f.Operator
            FilterArray(i, 3) = Dict.Items
            Resume NextFilter
          Case 8 'xlFilterCellColor
            FilterArray(i, 1) = f.Criteria1.Color
            FilterArray(i, 2) = f.Operator
            Resume NextFilter
          Case Else
            'This .Operator has a value but .Criteria2 doesn't, can be ignored
            Resume Next
        End Select
      End With
    End Sub
    
    Sub RestoreAutofilter(ByRef FilterArray As Variant, _
        Optional ByVal W As Worksheet = Nothing)
      'Restore the filter settings of an auto filter (see RestoreView as alternative)
      Dim i As Integer
      If W Is Nothing Then Set W = ActiveSheet
      If Not W.AutoFilterMode Then Exit Sub
      If W.FilterMode Then W.ShowAllData
      For i = 1 To UBound(FilterArray)
        If IsEmpty(FilterArray(i, 2)) Then
          If Not IsEmpty(FilterArray(i, 1)) Then
            W.AutoFilter.Range.AutoFilter i, FilterArray(i, 1)
          ElseIf Not IsEmpty(FilterArray(i, 3)) Then
            W.AutoFilter.Range.AutoFilter i, , , FilterArray(i, 3)
          End If
        Else
          If Not IsEmpty(FilterArray(i, 1)) Then
            If Not IsEmpty(FilterArray(i, 3)) Then
              W.AutoFilter.Range.AutoFilter i, FilterArray(i, 1), FilterArray(i, 2), _
                FilterArray(i, 3)
            Else
              'xlFilterValues / xlFilterDynamic / xlFilterFontColor
              W.AutoFilter.Range.AutoFilter i, FilterArray(i, 1), FilterArray(i, 2)
            End If
          Else
            If Not IsEmpty(FilterArray(i, 3)) Then
              'xlFilterValues with dates
              W.AutoFilter.Range.AutoFilter i, , FilterArray(i, 2), FilterArray(i, 3)
            Else
              W.AutoFilter.Range.AutoFilter i, , FilterArray(i, 2)
            End If
          End If
        End If
      Next
    End Sub
    
    Sub SaveView(Optional ByVal Wb As Workbook, Optional ByVal ViewName As String = "Temp", _
        Optional ByVal PrintSettings, Optional ByVal RowColSettings = True)
      'Save the current view of the active sheet
      If Wb Is Nothing Then Set Wb = ActiveWorkbook
      Wb.CustomViews.Add ViewName, PrintSettings, RowColSettings
    End Sub
    
    Sub RestoreView(Optional ByVal Wb As Workbook, Optional ByVal ViewName As String = "Temp")
      'Restore a view (this can change the active sheet)
      If Wb Is Nothing Then Set Wb = ActiveWorkbook
      On Error Resume Next
      Wb.CustomViews(ViewName).Show
    End Sub

    Donnerstag, 9. April 2015 16:06
  • Huppsala, Du willst auf den Autofilter des ListObjects zugreifen, das geht natürlich ein bißchen anders:

    Sub Test()
      Dim L As ListObject
      Dim AF As AutoFilter
      Dim Fs As Filters
      Dim F As Filter
      Set L = ActiveSheet.ListObjects(1)
      Set AF = L.AutoFilter
      Set Fs = AF.Filters
      For Each F In Fs
        If F.On Then
          'Gesetzt
        End If
      Next
    End Sub

    Allerdings gilt alles andere was ich gesagt habe unverändert auch dafür.

    Andreas.

    • Als Antwort markiert Ferby_ Mittwoch, 9. März 2016 09:08
    Donnerstag, 9. April 2015 16:23