按所选单元格值筛选

weixh107

    以下是我正在使用的一段代码，也是网上摘抄的，可以代替右键-筛选-按所选单元格值筛选。可是因为行数达到几千行之后，速度非常慢（右键筛选没有这个问题），麻烦各位大神帮我修改一下，或者可以录制宏实现都行~
Sub 筛选当前单元格值()
'
' 筛选当前单元格值 Macro
'
     Dim tmpStr As String, i As Long, j As Integer
    Dim Title As Integer, calcState, displayPageBreakState
    calcState = Application.Calculation
    displayPageBreakState = ActiveSheet.DisplayPageBreaks
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    ActiveSheet.DisplayPageBreaks = False

    Title = 3   '标题的最大行，从此行以下开始筛选
    tmpStr = ActiveCell.Value
    j = ActiveCell.Column()
    For i = Title + 1 To Range("A1").SpecialCells(xlLastCell).Row()
        If Cells(i, j).Value <> tmpStr Then Cells(i, j).EntireRow.Hidden = True
    Next i
    Cells(Title + 1, j).Select

    Application.ScreenUpdating = True
    Application.Calculation = calcState
    ActiveSheet.DisplayPageBreaks = displayPageBreakState
End Sub