falmrom, макрос работает по столбцу с активной ячейкой. Была ошибка, а точнее не учтены вероятные пустые значения. Поэтому фильтр после встреченных пустых сразу возвращался в начало.
Вот обновленная версия (кнопки переназначены на новые макросы):
Код |
---|
Sub PrevFilter()'назад
Application.ScreenUpdating = False
SetAutoFilter -1
Application.ScreenUpdating = True
End Sub
'---------------
Sub NextFilter()'вперед
Application.ScreenUpdating = False
SetAutoFilter 1
Application.ScreenUpdating = True
End Sub
'---------------
Sub SetAutoFilter(ByVal z%)
Dim aa As Range, DC As Object, a&, b%, dt$, arr()
Set DC = CreateObject("Scripting.Dictionary")
Set aa = ActiveCell.CurrentRegion
b = ActiveCell.Column
arr = Intersect(aa, ActiveCell.EntireColumn).Value
For a = 2 To aa.Rows.Count
If Not DC.exists(CStr(arr(a, 1))) Then DC.Add CStr(arr(a, 1)), DC.Count
Next
If DC.Count < 1 Then Exit Sub
arr = DC.keys()
If ActiveSheet.AutoFilterMode Then
With ActiveSheet
.AutoFilter.Range.Cells(1, b).Select
If .AutoFilterMode Then
If .AutoFilter.Filters(b).On Then
dt = Replace(.AutoFilter.Filters(b).Criteria1, "=", "")
End If
aa.AutoFilter field:=b
Select Case z
Case Is > 0
If DC.Item(dt) = UBound(arr) Then
aa.AutoFilter field:=b, Criteria1:="=" & arr(1), Operator:=xlFilterValues
Else: aa.AutoFilter field:=b, Criteria1:="=" & arr(DC.Item(dt) + 1), Operator:=xlFilterValues
End If
Case Else
If DC.Item(dt) = LBound(arr) Then
aa.AutoFilter field:=b, Criteria1:="=" & arr(UBound(arr)), Operator:=xlFilterValues
Else: aa.AutoFilter field:=b, Criteria1:="=" & arr(DC.Item(dt) - 1), Operator:=xlFilterValues
End If
End Select
End If
End With
End If
End Sub
|