O AutoFiltro do Excel 2010 não filtra

1

Eu tenho uma planilha com 69 colunas e 6600 linhas chamada Raw Data. Eu também tenho uma planilha chamada Filtered Data. Eu tenho um menu suspenso na planilha de dados filtrados na célula B4. A lista no menu suspenso corresponde às colunas de dados na planilha de dados brutos. Eu uso a célula B5 para inserir um valor mínimo e a célula B6 para inserir um valor máximo. Quero filtrar a planilha de dados brutos de acordo com a coluna selecionada por meio do menu suspenso, de modo que os valores nessa coluna sejam maiores ou iguais ao meu valor mínimo e menores ou iguais ao meu valor máximo.

O código não filtra.

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
    
por PBrenek 03.05.2013 / 21:30

2 respostas

1

Eu finalmente consegui fazer o autofiltro funcionar. O seguinte é o que eu usei:

    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

Não é perfeito, pois não copia o cabeçalho, mas funciona. A outra questão é que os critérios não parecem estar funcionando. Trabalharemos nisso.

    
por 04.05.2013 / 21:38
0

Eu estava entendendo mal você.

Você quer usar

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

isso filtrará toda a região em que essas células estão.

Como alternativa, você pode usar algo como (se houver células ou espaços ausentes, isso pode ser útil).

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