【问题标题】:How to remove blank rows when using Excel VBA Autofilter使用 Excel VBA 自动筛选时如何删除空白行
【发布时间】:2011-12-06 10:22:38
【问题描述】:

我编写了一个宏,它可以搜索工作簿并将自动过滤器应用于任何具有名为“代码”的列的列表对象。但是,当我应用过滤器时,它不会过滤掉空白行。知道如何过滤掉这些吗?

这是应用过滤器的代码:

Public Sub ApplyFilter(filter As Variant)
Dim wb As Workbook
Dim ws As Worksheet
Dim lo As ListObject

Set  wb = ActiveWorkbook

' Loop through each sheet in the workbook
For Each ws In wb.Sheets
    ' Find any listobjects within the sheet
    For Each lo In ws.ListObjects
        Dim r As Integer
        ' Find the column named Code and filter on this column
        r = lo.Range.Rows(1).Find("Code").Column
        ' Clear any existing filter
        lo.Range.AutoFilter Field:=r
        ' If the filter code is not "All Categories", 999, apply the filter
        If filter(0) <> 999 Then
            lo.Range.AutoFilter Field:=r, Criteria1:=filter, Operator:=xlFilterValues
        End If
    Next
Next

End Sub

传入的过滤器是一个数组,它可能只有一个或多个条件。我也尝试过添加条件2:=“”,但这并没有改变任何东西。

如果您有任何想法,请告诉我。谢谢!

这是其他相关代码:

Public Sub FilterInvoice(filter As Range)
    Me.ApplyFilter Me.BuildFilter(filter)
End Sub

Public Function BuildFilter(filter As Range) As Variant
    Dim r As Range
    Dim arFilter() As String

    ' Get the cell of the current category
    Set r = Range("Categories").Find(filter.Value)

    ' Set the initial filter value to the category id
    ReDim Preserve arFilter(1)
    arFilter(0) = r.Offset(0, -1).Value

    ' Find any child categories, add child id's to filter array
    For c = 1 To Application.CountIf(Range("Categories").Columns(3), arFilter(0))
        Dim PrevChild As Range
        ' Expand the filter array
        ReDim Preserve arFilter(c + 1)
        If c = 1 Then
            Set PrevChild = Range("Categories").Columns(3).Find(arFilter(0))
        Else
            ' If it is not the first time through the loop, look for the next child after PrevChild
            Set PrevChild = Range("Categories").Columns(3).Find(arFilter(0), PrevChild)
        End If
        ' Offset the found child to get its code, add it to the filter array
        arFilter(c) = PrevChild.Offset(, -2)
    Next

    ' Add "<>" and "<900" to the criteria list to hide blank rows
    'ReDim Preserve arFilter(UBound(arFilter) + 2)
    'arFilter(UBound(arFilter) - 1) = "<>"
    'arFilter(UBound(arFilter)) = "<900"

    'Return the filter array
    BuildFilter = arFilter
End Function

【问题讨论】:

    标签: excel vba autofilter


    【解决方案1】:

    如果您使用数组按多个条件进行过滤,则不包括“=”,自动过滤器应该过滤空白。例如,这不会过滤空白:

    Criteria1:=Array("test", "2", "3", "4", "=")
    

    您可能需要使用 specialcells(xlcelltypeblanks) 手动隐藏它们。

    编辑:

    好的,我想我的第一个解决方案可能会让您感到困惑。我已经删除了。

    现在我可以看到您的代码,我认为可能发生的情况是,当您循环遍历范围并添加您的条件时,您可能正在添加一个空白单元格。一次一步地遍历循环,并确保不是这种情况。您可以添加它以显示过滤器并确保它不包含空格:

    Debug.Print Join(arfilter, ",")

    【讨论】:

    • 您介意扩展吗?我需要一个标准作为我的数组,其中包含我要过滤的代码。我尝试将数组用作标准一,将“”用作标准 2,但没有给出任何结果。如果我将运算符设置为 xlFilterValues,它会给出原始结果(带有空白行)。出于好奇,“”标准是什么意思?
    • 如果您需要更多帮助,请向我展示填充您正在使用的实际过滤器并调用 applyfilter 子例程的代码。
    • 猜猜它会是手工的。我通过构建过滤器代码进行更改,将“”和“
    • 你是对的。我需要我的第一个 redim preserve 是 redim preserve arfilter(0),而不是 arfilter(1)。感谢您的帮助!
    【解决方案2】:

    我知道这是一个老问题,但我在 Internet 上的任何地方都找不到任何令人满意的答案

    所以我想分享一个似乎效果很好的解决方案:

    ActiveSheet.Range("$A$1:$V$3000").AutoFilter Field:=ActiveSheet.Range("$A$1:$V$1").Find("Monitoring").Column, _
    Criteria1:="<>Done", Operator:=xlFilterValues
    

    空白单元格仍然存在,因此我们无需过滤掉它们

    ActiveSheet.Range("$A$1:$V$1").Find("Monitoring").EntireColumn.SpecialCells(xlCellTypeBlanks).EntireRow.Hidden = True
    

    当然因为它使用 xlFilterValues 你也可以使用数组过滤器

    ActiveSheet.Range("$A$1:$V$3000").AutoFilter Field:=ActiveSheet.Range("$A$1:$V$1").Find("Monitoring").Column, _
    Criteria1:=Array( _
         "Department1", "Department2", "Department3", "Department4", _
        "Department5", "Department6", "="), Operator:=xlFilterValues
    

    希望你喜欢!

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多