改进后的自动筛选代码（原创）

下面的代码是在修改关键字单元格时自动触发，所以要写在 WorkSheet 中：


关于查询关键字
要查询的关键字应该放在两行，上面一行为列标题，下面一行为对应的取值，如要查询4年4班的学生，：

Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Address = "$H$2" or Target.Address = "$I$2"Then
  
    ' 修改H2或I2单元格将触发高级筛选，A4:G1415为需要筛选的数据区域（含标题行）

    ' 查询条件中可以包含通配符

    Range("A4:G1415").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("H1:I2"), Unique:=False

    ' 取得筛选后得到的行数
    [A4:G1415].SpecialCells(xlCellTypeVisible).Select
    ResultRows = Selection.Rows.Count

    ' 取得筛选后第一行的行号，如果要对筛选结果进行复制，需要引用行号，配合上面的返回行数即可解决
    FirstVisibleRow = [a5:a1415].SpecialCells(12)(1, 1).Row

    
    ' 如果筛选结果为空，将引发“单元格未找到”的错误，因此需捕捉错误
    On Error GoTo mark
    
    ' SpecialCells(12) 为可见单元格，后面的(1, 1)指该区域内的第一行，第一列所指的单元格

    ' 对筛选结果进行判断时排除标题行，因此下面从第 5 行开始判断

    If [a5:a1415].SpecialCells(12)(1, 1).Row > 0 Then
        ' 移动当前焦点到筛选后结果中的第一行 D 列，去录入数据区
        VisibleRowNum = [a5:a1415].SpecialCells(12)(1, 1).Row
        Range("d" & VisibleRowNum).Select
        Exit Sub
    End If
mark:
    ' 错误处理，如果筛选结果为空，输入焦点保持在 C2 单元格
    Range("C2").Select
    Exit Sub
    
  End If
  
  ' 数据录入后，焦点返回至查询框
  If Target.Column = 4 Then
    Range("C2").Select
  End If
  

End Sub

 

如果要把高级筛选的结果复制到另一工作表的话，需要注意：

    ' VBA中调用高级筛选，对 sheet1 中的数据筛选并将结果复制到 sheet2 中
    Sheets("Sheet2").Select '筛选结果复制模式如果要把结果复制到另一个sheet，目标sheet必须为当前sheet
    Sheets("Sheet1").Range("A4:E847").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sheets("Sheet1").Range("G4:H5"), CopyToRange:=Range("A1"), Unique:=True