【问题标题】:Non-contiguous array as filter criteria for xlfiltervalues非连续数组作为 xlfiltervalues 的过滤条件
【发布时间】:2017-11-16 15:37:20
【问题描述】:

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

我有一个折扣选项列表,我们将它们命名为范围 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

【问题讨论】:

  • “用户过滤掉他们不想申请的折扣。我需要根据用户选择取消过滤、工作和重新过滤。”。什么样的工作?根据“工作”的性质,这也许可以使用数据透视表来执行。 (如果您有 Excel 2013 或更高版本,也可以使用 DataModel。)
  • 感谢您的回答!可悲的是,当它们出来时我没有学习数据透视表,感觉就像一只老狗????这项工作基本上是在过滤器上方插入行和分页符

标签: arrays excel vba filter criteria


【解决方案1】:

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

现在终于像魅力一样工作了。只花了我一整天时间才找到适用于 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

【讨论】:

    猜你喜欢
    • 2021-03-16
    • 1970-01-01
    • 2021-10-20
    • 1970-01-01
    • 2021-01-13
    • 2017-02-11
    • 2021-03-08
    • 1970-01-01
    • 2017-02-09
    相关资源
    最近更新 更多