☰

Excel 2010 自动筛选无法筛选

tag-icon • tag-icon microsoft-excel-2010 vba
Excel 2010 自动筛选无法筛选

我有一张包含 69 列和 6600 行的名为“原始数据”的工作表。我还有一张名为“过滤数据”的工作表。在“过滤数据”工作表的单元格 B4 中有一个下拉菜单。下拉菜单中的列表对应于“原始数据”工作表中的数据列。我使用单元格 B5 输入最小值，使用单元格 B6 输入最大值。我想根据通过下拉菜单选择的列过滤“原始数据”工作表，以使该列中的值大于或等于我的最小值并小于或等于我的最大值。

代码没有过滤。

Private Sub ExtractData(ByVal Filter As Range)
'Dim variables
Dim LR As Long, NR As Long
Dim filterItem As String
Dim minValue As Variant, maxValue As Variant
Dim colNum As Integer
Dim rng As Range, min As Range, max As Range
Dim shSource As Worksheet
Dim shDest As Worksheet

'Set range and source and target worksheets
Set shSource = ThisWorkbook.Sheets("Raw Data")
Set shDest = ThisWorkbook.Sheets("Filtered Data")

'shSource.Range("D11:BP11") is the list of all possible drop down menu items
Set rng = shSource.Range("D11:BP11")

'Set min and max filter cells
Set min = shDest.Range("B5")
Set max = shDest.Range("B6")

'Define min and max filter values
minValue = shDest.Range("B5").Value
maxValue = shDest.Range("B6").Value

filterItem = Filter.Value
'Determine which column contains the filter category
colNum = Application.Match(filterItem, rng, 0)

If Not IsError(colNum) Then
    Select Case colNum
        Case 1 To 3:  'Columns B to F
            min.NumberFormat = "@"  'string format
            max.NumberFormat = "@"
        Case 4 To 11, 14, 22 To 23, 29, 33 To 37, 46 To 47, 57, 60 To 61, 63, 65:
            min.NumberFormat = "0.00"  'number format
            max.NumberFormat = "0.00"
        Case Else:
            min.NumberFormat = "0.00%"  'percentage format
            max.NumberFormat = "0.00%"
    End Select

    NR = shDest.Range("A" & rows.Count).End(xlUp).Offset(1).Row 'Go to cell below last used cell in column A

    With shSource
        LR = .Cells(rows.Count, "A").End(xlUp).Row  'Last row of column A
        .AutoFilterMode = False
        With .Range("A12" & LR)
            .AutoFilter Field:=colNum, Criteria1:=">=" & minValue, Operator:=xlAnd, Criteria2:="<=" & maxValue, VisibleDropDown:=False
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy shDest.Range("A" & NR)
            .AutoFilter
        End With
    End With
Else
    MsgBox filterItem + " filter criterion was not found."
End If

shDest.Activate
End Sub

答案1

我终于让自动过滤器工作了。以下是我使用的：

    With shSource
        LR = .Cells(rows.Count, "B").End(xlUp).Row 'Last row of column B
        .AutoFilterMode = False
        With .Range("B11:BQ" & LR)
            .AutoFilter Field:=colNum, Criteria1:=">=" & minValue, Operator:=xlAnd, Criteria2:="<=" & maxValue, VisibleDropDown:=False
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy shDest.Range("A" & NR)
            .AutoFilter
        End With
    End With

不完美，因为它不会复制标题，但它可以工作。另一个问题是标准似乎不起作用。将努力解决这个问题。

答案2

我误解你了。

你想使用

Dim str As String
str = Range("a12").CurrentRegion.Address
Range(str).AutoFilter
'or
Range("A12").CurrentRegion.AutoFilter

这将过滤这些细胞所在的整个区域。

或者，您可以使用类似的东西（如果缺少单元格或孔洞，这可能会有用）。

Dim str As String
str = "a12:BQ" & shDest.Range("A" & rows.Count).End(xlUp).Offset(1).Row
Range(str).AutoFilter

相关内容