根据输入范围自动过滤Excel范围

时间:2015-01-03 23:50:32

标签: excel vba excel-vba autofilter

在excel电子表格中,我有3列数据。列A + B输入文本,列C为数字(1-5)。我将创建一个输入框。根据输入,它将过滤C列的结果。

例如:

如果我输入G,则该条件将过滤具有1,2&的C列的结果。 4

如果我输入A,则该条件将过滤具有1&的C列的结果。 3

这可能吗?我的想法是这些宏来过滤结果然后将其导出到新的电子表格。有没有其他方法这样做?对不起,奖励说明:S

1 个答案:

答案 0 :(得分:3)

这使用Range.AdvancedFilter方法further described here根据用户输入过滤数据,并将过滤后的数据复制到同一工作簿中的第二个工作表。

由于AdvancedFilter需要一些“设置”,因此在我的示例中进行了以下假设。您可能需要根据您的要求更改这些。

有两个工作表,一个(包含数据)包含您的数据;和第二个(称为结果)包含AdvancedFilter标准和复制的结果。假设该第二张纸是空白纸。标准以编程方式应用于此表。

您的数据必须包含数据标题。如果您在我的示例中更改了名为“Criteria”的标题,那么您还需要在代码中更改此标题。

Data

您可以根据需要在代码中添加其他过滤条件。

如果否,或者输入框中输入了未知的过滤器ID,则所有数据都将复制到结果表中。如果重新运行Sub,结果表将自动清除。应用过滤器值G的示例如下所示:

Results for filter 'G'

Option Explicit
Sub advFiltVals()

Dim wsData As Worksheet, wsResult As Worksheet
Dim frstRow As Long, lstRow As Long, stcol As Long, endcol As Long
Dim critStRow As Long, critStCol As Long
Dim copyStRow As Long, copyStCol As Long
Dim filtVal As String
Dim critRng As Range, copyToRng As Range

Set wsData = Sheets("Data")
Set wsResult = Sheets("Results")

'data
frstRow = 1
stcol = 1
endcol = 3
'result
critStRow = 1   'header row
critStCol = 1
copyStRow = 2
copyStCol = 3

    With wsResult
        .UsedRange.Clear
        Set copyToRng = .Cells(copyStRow, copyStCol)
        .Cells(critStRow, critStCol).Value = "Criteria"

        filtVal = InputBox("Enter filter value.")

        Select Case UCase(filtVal)
            Case Is = "A"
                .Cells(critStRow, critStCol).Offset(1, 0) = 1
                .Cells(critStRow, critStCol).Offset(2, 0) = 3
                Set critRng = .Range(.Cells(critStRow, critStCol), .Cells(critStRow, critStCol).Offset(2, 0))
            Case Is = "G"
                .Cells(critStRow, critStCol).Offset(1, 0) = 1
                .Cells(critStRow, critStCol).Offset(2, 0) = 2
                .Cells(critStRow, critStCol).Offset(3, 0) = 4
                Set critRng = .Range(.Cells(critStRow, critStCol), .Cells(critStRow, critStCol).Offset(3, 0))
            Case Else
                Set critRng = .Cells(critStRow, critStCol)
        End Select
    End With

    With wsData
        If .FilterMode = True Then
            .ShowAllData
        End If

        lstRow = .Cells(Rows.Count, endcol).End(xlUp).Row

        With .Range(.Cells(frstRow, stcol), .Cells(lstRow, endcol))
            .AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=critRng, CopyToRange:=copyToRng, Unique:=False
        End With
    End With
End Sub