从列创建唯一的列表显示在下拉的结果下来用丝带栏中显示的工作表上的过滤器

Question

我在一张纸上称为DataCalcs 29000个加行。在列AG我有一个像以下值：

Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
Altern 1
Base   2
Base   2
Base   2
Base   2
Base   2

等在列AG

我需要的代码，将过滤这些数据并显示什么，从我已经在Excel功能区中创建一个自定义菜单过滤。

我还需要在基于列的唯一选择过滤DataCalcsthat选择从功能导航栏的下拉菜单中AG工作表上显示的数据。

我也有一个叫DataCalcs所以请随意使用命名范围代码范围内保存这些数据。

感谢您寻找和阅读！

Answer 1

这些程序做的工作： Sub AdvFilter实际上是代码只有一行。 Sub AdvFilterSort包括对结果进行排序的可能性。

Option Explicit

'Sub AdvFilter and Sub AdvFilterSort
'based on https://stackoverflow.com/questions/32787227/vba-advanced-filter-unique-values-and-copy-to-another-sheet

Sub AdvFilter(InputRange As Range, OutputRange As Range)
    InputRange.AdvancedFilter Action:=xlFilterCopy, copytorange:=OutputRange, Unique:=True
End Sub

Sub AdvFilterSort(InputRange As Range, OutputRange As Range, Optional sortHeader As Integer, Optional sortAscOrDesc As Integer)
    Dim sortRange As Range
    InputRange.AdvancedFilter Action:=xlFilterCopy, copytorange:=OutputRange, Unique:=True
    If sortAscOrDesc = xlAscending Or sortAscOrDesc = xlDescending Then
        Set sortRange = OutputRange.CurrentRegion
        sortRange.Sort key1:=OutputRange, Order1:=sortAscOrDesc, Header:=sortHeader
    End If
End Sub

这个过程调用AdvFilter / AdvFilterSort你的“DataCalcs”的数据：

Option Explicit

Sub Call_AdvFilter()
    Dim agRange As Range
    Dim lastRow As Long

    'Create a new sheet for the results : "newSheet"

    If sheetExists("newSheet") Then
        'nothing to do
    Else
        'create sheet and name it "newSheet"
        Sheets.Add after:=Sheets(Sheets.Count)
        ActiveSheet.Name = "newSheet"
    End If
    lastRow = Worksheets("DataCalcs").Range("A1").SpecialCells(xlCellTypeLastCell).Row
    Set agRange = Range("DataCalcs!AG1:AG" & lastRow)

    'Delete result columns
    Range("newsheet!A:H").Delete

    With Worksheets("newSheet")
        .Range("A1:H3").Font.Bold = True
        .Range("A1:H1").Font.Size = 14
        .Range("A3:H3").Font.Size = 12

        'using column ag data defined with lastrow
        .Range("A1").Value = "Column AG data (lastrow):"

        'result sorted:
        .Range("A3").Value = "sorted"
        Call AdvFilterSort(Range("DataCalcs!AG1:AG3340"), .Range("A5"), xlNo, xlAscending)

        'result not sorted:
        .Range("C3").Value = "not sorted"
        Call AdvFilter(Range("DataCalcs!AG1:AG3340"), .Range("C5"))


        'using predefined range named "DataCalcs"
        .Range("F1").Value = "defined Name ""DataCalcs"":"

        'result sorted:
        .Range("F3").Value = "sorted"
        Call AdvFilterSort(Range("DataCalcs"), .Range("F5"), xlNo, xlAscending)

        'result not sorted:
        .Range("H3").Value = "not sorted"
        Call AdvFilter(Range("DataCalcs"), .Range("H5"))

    End With
End Sub

这是上面使用一个很好的sheetExists功能：

Function sheetExists(sheetToFind As String) As Boolean
    'copied from:
    'https://stackoverflow.com/questions/6040164/excel-vba-if-worksheetwsname-exists
    'by Dante is not a Geek
    'https://stackoverflow.com/users/571433/dante-is-not-a-geek
    Dim mySheet As Worksheet
    sheetExists = False
    For Each mySheet In Worksheets
        If sheetToFind = mySheet.Name Then
            sheetExists = True
            Exit Function
        End If
    Next mySheet
End Function