根据输入范围自动过滤Excel范围
Auto-filtering Excel Range based on input range
在 excel 电子表格中,我有 3 列数据。 A+B 列输入了文本,C 列为数字 (1-5)。我将创建一个输入框。根据输入,它将过滤 C 列的结果。
例如:
如果我输入 G,此条件将筛选具有 1,2 和 4 的 C 列的结果
如果我输入 A,此条件将筛选具有 1 和 3 的 C 列的结果
这可以吗?我的想法是使用这些宏来过滤结果,然后将其导出到新的电子表格。还有其他方法吗?抱歉获奖说明:S
这使用 Range.AdvancedFilter
方法 further described here 根据用户输入过滤您的数据,并将过滤后的数据复制到同一工作簿中的第二个工作sheet。
因为 AdvancedFilter 需要一些 'setting-up',所以在我的示例中做出了以下假设。您可能需要根据您的要求更改这些。
有两个工作sheet,一个(称为数据)包含您的数据;第二个(称为结果)包含 AdvancedFilter 条件和复制的结果。第二个 sheet 被假定为空白 sheet。标准以编程方式应用于此 sheet.
您的数据必须有数据标题。如果您在我的示例中更改名为 'Criteria' 的标题,那么您还需要在代码中更改它。
您可以根据需要在代码中添加其他过滤条件。
如果没有,或者在输入框中输入了未知的过滤器 ID,则所有数据都会复制到结果 sheet。如果 Sub 是 re-run,结果 sheet 会自动清除。应用过滤器值 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
在 excel 电子表格中,我有 3 列数据。 A+B 列输入了文本,C 列为数字 (1-5)。我将创建一个输入框。根据输入,它将过滤 C 列的结果。
例如:
如果我输入 G,此条件将筛选具有 1,2 和 4 的 C 列的结果
如果我输入 A,此条件将筛选具有 1 和 3 的 C 列的结果
这可以吗?我的想法是使用这些宏来过滤结果,然后将其导出到新的电子表格。还有其他方法吗?抱歉获奖说明:S
这使用 Range.AdvancedFilter
方法 further described here 根据用户输入过滤您的数据,并将过滤后的数据复制到同一工作簿中的第二个工作sheet。
因为 AdvancedFilter 需要一些 'setting-up',所以在我的示例中做出了以下假设。您可能需要根据您的要求更改这些。
有两个工作sheet,一个(称为数据)包含您的数据;第二个(称为结果)包含 AdvancedFilter 条件和复制的结果。第二个 sheet 被假定为空白 sheet。标准以编程方式应用于此 sheet.
您的数据必须有数据标题。如果您在我的示例中更改名为 'Criteria' 的标题,那么您还需要在代码中更改它。
您可以根据需要在代码中添加其他过滤条件。
如果没有,或者在输入框中输入了未知的过滤器 ID,则所有数据都会复制到结果 sheet。如果 Sub 是 re-run,结果 sheet 会自动清除。应用过滤器值 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