Question

我有几列有几百行数据。我的一个角色是浏览数据（最常见的是第2列），所以我要点击列标题上的小下拉箭头打开自动过滤列表，取消选择第一个值，然后选择下一个值。然后，同样，打开菜单，取消选择第二个值并选择第三个。

也没有固定数量的值。不同的数据表具有不同数量的数据。数据通常像0,10,40,50,60，....再次，它不是固定的。然而，它是一个阵列。所有数据已经按顺序递增。

我需要什么：

最好是一个点击按钮（对于第2列）取消选择当前所选值的按钮，选择下一个值并过滤掉
相反。即取消选择当前值，选择以前的值

基本上我需要一个转发和返回按钮来获取我的数据。

这是我在尝试记录行动时得到的结果。

Sub a()

ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/000"
    ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/010"
ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:
    ="750385/017"

End Sub

感谢任何帮助!!

Answer 1

我会在工作表上使用Spinbuttons并将它们链接到列的第一个单元格，它想要过滤。

（我称之为spbFilterChange并将其链接到$ B $ 1）

（图片上传在这里不起作用，抱歉）

然后，您可以将以下代码放在工作表的模块中：

Private Sub spbFilterChange_SpinDown()
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), False
End Sub

Private Sub spbFilterChange_SpinUp()
    Change_Filter Me.Range(Me.spbFilterChange.LinkedCell), True
End Sub

以下子标准模块：

Option Explicit

Sub Change_Filter(SortField As Range, Up As Boolean)
Dim Filter_Values As Collection
Dim Value_Arr, Val, Sort_Value As String
Application.ScreenUpdating = False
    ' Find Unique Values in relevant Column -> Collection
    Set Filter_Values = New Collection
    SortField.Offset(2, 0).Areas(1).AutoFilter SortField.Column
    Value_Arr = SortField.Parent.Range(SortField.Offset(3, 0), SortField.Parent.Cells(SortField.Parent.Rows.Count, SortField.Column).End(xlUp)).Value2
    On Error Resume Next
    For Each Val In Value_Arr
        Filter_Values.Add Val, CStr(Val)
    Next Val

    ' Check if Value of LinkedCell is in range
    If SortField.Value < 1 Or SortField.Value > Filter_Values.Count Then SortField.Value = 1

    ' set autofilter
    Sort_Value = Filter_Values(SortField.Value)
    SortField.Offset(2, 0).AutoFilter SortField.Column, Sort_Value
Application.ScreenUpdating = True
End Sub

这可以解决您的问题，可以在不同的列和表上使用（您必须在工作表模块中添加事件过程的另一个副本）。

Answer 2

有一种方法可以读出curent过滤器，从中可以循环通过该列，直到找到该值。在这里你只需要跳到下一行的值，现在你可以将其放入过滤器。

总之，这种方法将是你的“前进”按钮

Sub test()
    Dim startRow As Integer
    startRow = 2
    Dim rangeString As String
    rangeString = "$A$2:$V$609"


    Dim rng As Range
    Set rng = Range(rangeString)

    Dim currentCrit As String
    currentCrit = rng.Parent.AutoFilter.Filters(2).Criteria1
    currentCrit = Right(currentCrit, Len(currentCrit) - 1)

    Dim i As Integer
    For i = startRow To startRow + rng.Rows.Count
        If Cells(i, 2).Value = currentCrit Then
            i = i + 1
            Exit For
        End If
    Next

    If i > rng.Rows.Count + startRow Then
        Exit Sub
    End If

    ActiveSheet.Range(rangeString).AutoFilter Field:=2, Criteria1:=Cells(i, 2).Value
End Sub

注意：如果您在B列中有重复项，则不起作用，如果是这样，则使用以下内容替换具有For-Loop的零件：

Dim i As Integer
Dim bool As Boolean
bool = False
For i = startRow To startRow + rng.Rows.Count
    If Cells(i, 2).Value = currentCrit Then
        bool = True
    End If

    If bool And Cells(i, 2).Value <> currentCrit Then
        Exit For
    End If
Next

希望我能提供帮助。

Answer 3

我会做这样的事情。

首先：获取帮助列X，例如，从列B复制所有唯一数据。

Option Explicit

Sub CreateUniqueList()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row

    ActiveSheet.Range("B1:B" & lastrow).AdvancedFilter _
    Action:=xlFilterCopy, _
    CopyToRange:=ActiveSheet.Range("X1"), _
    Unique:=True
    ActiveSheet.Range("Y1").Value = "x" 
End Sub

你的名单可能会像这样：

之后，你需要一个循环按钮：

像这样。

//代码不是Testet //

    Sub butNextValue()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row


For i = 2 To lastrow
    If ActiveSheet.Cells(i, 25).Value = "x" Then
        If Not ActiveSheet.Cells(i+1, 24)-value = "" Then 'check if next value is there
            ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i+1, 24)-value
        Else
            MsgBox "No more Next Values"
        End If
        Exit For
    End If
Next i

End Sub

Sub butPriValue()
Dim lastrow As Long

lastrow = Cells(Rows.Count, "B").End(xlUp).Row


For i = 2 To lastrow
    If ActiveSheet.Cells(i, 25).Value = "x" Then
        If Not ActiveSheet.Cells(i-1, 24)-value = "Set" OR Not ActiveSheet.Cells(i-1, 24)-value = "" Then 'check if next value is there
            ActiveSheet.Range("$A$2:$V$609").AutoFilter Field:=2, Criteria1:=ActiveSheet.Cells(i-1, 24)
        Else
            MsgBox "No more Pri Values"
        End If
        Exit For
    End If
Next i

End Sub

Excel vba在autofilter下拉菜单中选择下一个选项

3 个答案: