Автофильтр Excel 2010 не фильтрует

Question

У меня есть лист с 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

Answer 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

Не идеально, так как не копирует заголовок, но работает. Другая проблема заключается в том, что критерии, похоже, не работают .. Будет работать над этим.

Answer 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