非连续数组作为 xlfiltervalues 的过滤条件

Non-contiguous array as filter criteria for xlfiltervalues

常见问题,我已经解决了我找到的所有答案,最终几乎可以正常工作。

我有一个折扣选项列表,我们称它们为命名范围 F,向下 1 列。 用户过滤掉他们不想应用的折扣。 我需要根据用户选择取消筛选、执行工作和重新筛选。

我通过循环和范围联合创建了一个仅包含可见单元格的数组。这可以正常工作,但通常会生成一个不连续的数组。

当我 运行 这样做时,我没有收到错误。但是,不重新筛选连续数组中中断下方的条目。

刚刚意识到转置不喜欢非连续数组 - 仍然需要帮助,毫无疑问其他人也有同样的问题所以保持原样

说服 Criteria1 将最后一个元素包含在我的非连续数组中的最简单、最轻松(快到星期五了)的方法是什么?

Sub Filters()

'Dimension variables
Dim Rng As Range
Dim i, Lim As Integer
Dim w As Worksheet
Dim Op As Variant

Set w = ActiveSheet

'Set Lim as total number of rows in named range "F" (only 1 cell in use but same effect)
Lim = Range("F").Rows.Count

'Data has header row so skip to row 2
i = 2

'Loop through i up to limit
Do While i <= Lim
    'If the row is not hidden by the filters the user chose

    If Range("F")(i, 1).EntireRow.Hidden = False Then
        'Check if the range is nothing - if it is, union will not work to itself
        'Union requires non-empty arguments

        If Rng Is Nothing Then
            'Set the Rng to include the current cell from "F"
            Set Rng = Range("F")(i, 1)

        Else
            'If Rng has some value, add the current cell to it by Union
            Set Rng = Application.Union(Rng, Range("F")(i, 1))

        End If

    End If

    'Increment i
    i = i + 1

    Loop

    If w.AutoFilter.Filters.Item(1).Operator <> False Then Op = w.AutoFilter.Filters.Item(1).Operator

    'This gives the correct range, but most often non-contiguous
    MsgBox Range("F").Address

    'Remove AutoFilter
    w.AutoFilterMode = False




    'Insert Code Here




    'Put filters back

    'Check for Rng being non-empty (pointless running code if it is)
    If Not IsEmpty(Rng) Then
        'If there is an operator then use the array
        If Op Then
            'Found this option useful here - can transpose the array values which generates an array Criteria1 can use
            'Always xlFilterValues as there will always be more than 2 options
            'Also the options are taken from the worksheet live so won't change between times so specifying them precisely as strings is ok
            Range("F").AutoFilter Field:=1, Criteria1:=Application.Transpose(Rng.Value), _
            Operator:=xlFilterValues
        Else
            'Just filter the range but leave all options available
            Range("F").AutoFilter Field:=1
        End If
    End If

End Sub

通过使用第二个计数器来计算应作为条件包含的成功条目并将它们写入另一个工作表中的范围来回答。 然后将范围设置为新工作表中的新(连续)范围。

现在终于可以正常使用了。只花了我一整天的时间才找到适用于 Criteria 的语法,并且发现最多只能将 xlOr 用于 2 个条件,否则就是 xlfiltervalues...

尽可能通用的最终工作代码尽可能有用:

Sub Filters()

'Dimension variables
Dim Rng As Range
Dim i, j, Lim As Integer
Dim w As Worksheet
Dim Op As Variant

Set w = ActiveSheet

'Set Lim as total number of rows in named range "F" (only 1 cell in use but same effect)
Lim = Range("F").Rows.Count

'Data has header row so skip to row 2
i = 2

'Loop through i up to limit
Do While i <= Lim
    'If the row is not hidden by the filters the user chose

    If Range("F")(i, 1).EntireRow.Hidden = False Then
        'Check if the range is nothing - if it is, union will not work to itself
        'Union requires non-empty arguments

        If Rng Is Nothing Then
            'Set the Rng to include the current cell from "F"
            Set Rng = Range("F")(i, 1)
            Sheets("Sheet2").Range("A75").Value = Range("F")(i, 1).Value
            j = j + 1
        Else
            Sheets("Sheet2").Range("A1").Offset(j, 0).Value = Range("F")(i, 1).Value
            j = j + 1
        End If

    End If

'Increment i
i = i + 1

Loop

'If there's an operator, save it as variable Op (if needed)
If w.AutoFilter.Filters.Item(1).Operator <> False Then Op = w.AutoFilter.Filters.Item(1).Operator


'Remove AutoFilter
w.AutoFilterMode = False




'Insert Code Here

'Pause between the two halves
MsgBox ""



'Put filters back

'Check for Rng being non-empty (pointless running code if it is)
If Not IsEmpty(Rng) Then
    'If there is an operator then use the range
    If Op Then
        'Found this option useful here - can transpose the array values
        'Always xlFilterValues as there will always be more than 2 options
        'Also the options are taken from the worksheet live so won't change between times so specifying them precisely as strings is ok
        Range("F").AutoFilter Field:=1, Criteria1:=Application.Transpose(Sheets("Sheet2").Range("A75").Resize(j, 1).Value), _
        Operator:=xlFilterValues
    Else
        'Just filter the range but leave all options available
        Range("F").AutoFilter Field:=1
    End If
End If


End Sub