如何在VBA中创建多条件高级过滤器？

Question

我试图为下表创建一个advanced filter，但下面的代码只是隐藏了单元格。它的工作，但我的问题是，如果我过滤的东西，然后我拖动填充状态或任何其他单元格将覆盖其中的单元格，例如在过滤器模式下我有2行一个是第一行，另一个是在行20如果我拖动来填充状态，它将取代1到20之间的所有单元格的状态，但不知道如何解决，我知道发生这种情况的原因是我隐藏了单元格，而没有实际过滤它们。

任何帮助将不胜感激。

[数据表] [1]

Private Sub Worksheet_Change(ByVal Target As Range) 
Application.ScreenUpdating = False 
Application.EnableEvents = False 

r1 = Target.Row 
c1 = Target.Column 

If r1 <> 3 Then GoTo ending: 
If ActiveSheet.Cells(1, c1) = "" Then GoTo ending: 

Dim LC As Long 
    With ActiveSheet 
     LC = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
    End With 

    ActiveSheet.Range("4:10000").Select 
    Selection.EntireRow.Hidden = False 

    LR = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

For r = 5 To LR 

For c = 1 To LC 
If ActiveSheet.Cells(2, c) = "" Or ActiveSheet.Cells(3, c) = "" Then GoTo nextc: 
If ActiveSheet.Cells(2, c) = "exact" And UCase(ActiveSheet.Cells(r, c)) <> UCase(ActiveSheet.Cells(3, c)) Then ActiveSheet.Rows(r).EntireRow.Hidden = True: GoTo nextr: 
If Cells(2, c) = "exact" Then GoTo nextc: 
j = InStr(1, UCase(ActiveSheet.Cells(r, c)), UCase(ActiveSheet.Cells(3, c))) 
If ActiveSheet.Cells(2, c) = "partial" And j = 0 Then ActiveSheet.Rows(r).EntireRow.Hidden = True: GoTo nextr: 

nextc: 
Next c 

nextr: 
Next r 

ending: 
Application.EnableEvents = True 
Application.ScreenUpdating = True 
End Sub 

Answer 1

下面的代码将是回答关于如何基于关于什么用户在表中选择多个条件创建高级搜索的问题。

我将需要一些帮助，以便如何检查用户是否错误地选择了一个空单元，我需要使excel忽略过滤空单元。此外，我需要首先检查黄色单元格A3到T3是否有数据，如果有，并且按下过滤器按钮将按A3：T3范围进行过滤，如果没有数据，则忽略当前用户选择在范围A3中：T3将根据用户选择进行过滤，并在范围A3：T3中进行过滤，如果有数据将仅通过其中包含数据并忽略空数据的数据单元进行过滤。

Sub advancedMultipleCriteriaFilter() 

Dim cellRng As Range, tableObject As Range, subSelection As Range 
Dim filterCriteria() As String, filterFields() As Integer 
Dim i As Integer 

If Selection.Rows.Count > 1 Then 
MsgBox "Cannot apply filters to multiple rows within the same column. Please make another selection and try again.", vbInformation, "Selection Error!" 
Exit Sub 
End If 

Application.ScreenUpdating = False 
i = 1 
ReDim filterCriteria(1 To Selection.Cells.Count) As String 
ReDim filterFields(1 To Selection.Cells.Count) As Integer 
Set tableObject = Selection.CurrentRegion 
For Each subSelection In Selection.Areas 
For Each cellRng In subSelection 
filterCriteria(i) = cellRng.Text 
filterFields(i) = cellRng.Column - tableObject.Cells(1, 1).Column + 1 
i = i + 1 
Next cellRng 
Next subSelection 
With tableObject 
For i = 1 To UBound(filterCriteria) 
.AutoFilter field:=filterFields(i), Criteria1:=filterCriteria(i) 
Next i 
End With 
Set tableObject = Nothing 
Application.ScreenUpdating = True 
End Sub 

Sub resetFilters() 

Dim sht As Worksheet 
Dim LastRow As Range 

Application.ScreenUpdating = False 
    On Error Resume Next 
     If ActiveSheet.FilterMode Then 
    ActiveSheet.ShowAllData 
    End If 

Range("A3:T3").ClearContents 
Application.ScreenUpdating = True 
Call GetLastRow 

End Sub 

Private Sub GetLastRow() 

'Step 1: Declare Your Variables. 
    Dim LastRow As Long 
'Step 2: Capture the last used row number. 
    LastRow = Cells(Rows.Count, 8).End(xlUp).Row 
'Step 3: Select the next row down 
    Cells(LastRow, 8).Offset(1, 0).Select 

End Sub