Excel VBA动态过滤数据

Question

Screenshot of SourceReport Excel that need to be filtered.我需要根据同一工作表上提供的过滤条件，开发一个Excel VBA代码来过滤工作表上的数据。

下面是为同一个代码编写的代码..但是这段代码过滤了第1行而不是第4行的数据。你能建议改进吗？

Sub colFilter()

Dim ShtSource As Worksheet
Dim shtSrcHead As Range
Dim shtFilterData As Range
Dim filterStr As String

Set ShtSource = Sheets("SourceReport")
Dim lastCol As Long
Dim j As Long
Dim iCntr As Long

'get all of the filters of  sheet , assuming in row 2
lastCol = ShtSource.Cells(1, Columns.Count).End(xlToLeft).Column
Set shtSrcHead = ShtSource.Range("A2", ShtSource.Cells(1, lastCol))
Set shtFilterData = ShtSource.Range("A4", ShtSource.Cells(1, lastCol))

j = 0

'actually loop through and find values
For Each srcHead In shtSrcHead
j = j + 1
If j = lastCol Then
j = 0
End If

If srcHead.Value = "INCLUDE" Or srcHead.Value = "EXCLUDE" Then
  filterStr = srcHead.Offset(1, 0).Value
  If srcHead.Value = "INCLUDE" Then
  Debug.Print filterStr
    Debug.Print j

   shtFilterData.AutoFilter Field:=j, Criteria1:=filterStr
  End If

  If srcHead.Value = "EXCLUDE" Then
    Debug.Print filterStr
    Debug.Print j

   shtFilterData.AutoFilter Field:=j, Criteria1:="<>" & filterStr
  End If
End If
Next srcHead

MsgBox "Done!"
End Sub

Answer 1

根据下面的截图，使用以下子过滤多个条件。

Sub MyFilter()
    Dim include() As String
    Dim exclude As String
    Dim FiltRng As Range
    Dim RngArea, RngArea2 As Range

        'Set RngArea = Application.InputBox(prompt:="Select range include criteria.", Type:=8)
        'Set RngArea2 = Application.InputBox(prompt:="Select range exclude criteria.", Type:=8)

        'include = Split(RngArea, ",")

    include = Split(Range("C2"), ",")
    exclude = Range("B2")
    Set FiltRng = Sheet1.Range("B4:C11")
    FiltRng.AutoFilter Field:=2, Criteria1:=include, Operator:=xlFilterValues
    FiltRng.AutoFilter Field:=1, Criteria1:="<>" & exclude

End Sub

数据位置屏幕截图

  

调整数据范围的代码。