Excel VBA：使用計數器來計數篩選器結果

Question

我的名為Database的工作表包含許多行數據。 前兩列具有標題，用戶可以從下拉列表中的這些標題中進行選擇並過濾數據，以便僅顯示包含這些標題的結果。

除此之外，我還有另一個子程序GetNextResult。 這樣做的目的是將過濾后的結果中的某些值插入文本框。 這樣一來，用戶不必查看結果的行和行，他們可以單擊此按鈕，它將數據插入文本框，並且每次單擊它時，它都會顯示另一個結果。 顯示所有結果后，返回到再次顯示第一個結果。 它循環。

麻煩的是，用戶不知道何時返回到第一個結果。 我想添加一個計數器以跟蹤他們正在查看的結果。 因此，第一個過濾的結果將使計數器變為1，任何后續結果將為+ 1

我有一個名為

First_Row_Filtered

這會給我C列的值，該列在您過濾數據時顯示的第一行中。

使用此變量，我建立了一個if語句，以便如果文本框包含相同的值，則計數器將重置為1，即默認位置。

我的問題是計數器未將1正確添加到其他結果中。 它具有奇怪的行為。 當達到第一個結果的值時，它會重置為正確的1，但是下一個計數器編號會記住重置之前的位置，並從此處繼續計數，而不是從1開始計數。

例如：過濾數據時有3個結果。 首次單擊該按鈕時，計數器顯示1。這是正確的。 當您第二次單擊它時，它顯示2，正確。 當您第三次單擊它時，它顯示3，請更正。 當您第四次單擊它時，它顯示為1，這是正確的，因為沒有第四結果，它已循環回到第一個結果。 第五次單擊時，它會顯示4，應該顯示2，但是它是從重置到1之前的繼續計數。

我希望這是有道理的，我將代碼放在下面：

任何幫助將非常感激！

Public Sub GetNextResult()



    Call FilterData


    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Database")


    Dim header As String
    header = "txtbox1"

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row



    Dim DataRange As Range
    Set DataRange = ws.Range("A5", "J" & LastRow)


    Dim FilteredData As Range
    Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)



    First_Row_Filtered = Range("C6:C" & Rows.Count).SpecialCells(xlVisible)(1).Value



    If CurrentRow + 1 > FilteredData.Cells.Count Then
        CurrentRow = 1
    End If




    CurrentRow = CurrentRow + 1




    Dim i As Long
    Dim cell As Variant
    Static counter As Long



    ActiveSheet.Shapes("Cardcounter").TextFrame.Characters.Text = counter







    For Each cell In FilteredData


        i = i + 1
        If i = CurrentRow Then
            Call ShowAll


            TextboxName = "txtbox1"
            ActiveSheet.Shapes(TextboxName).DrawingObject.Text = cell.Offset(0, 2)

            TextboxName2 = "txtbox2"
            ActiveSheet.Shapes(TextboxName2).DrawingObject.Text = cell.Offset(0, 3)

            TextboxName3 = "txtbox3"
            ActiveSheet.Shapes(TextboxName3).DrawingObject.Text = cell.Offset(0, 4)


            If ActiveSheet.Shapes(TextboxName).DrawingObject.Text = header Then


                Call GetNextResult
            End If

            Call quick_artwork


        Else
            Call ShowAll


        End If



    Next cell



    If ActiveSheet.Shapes("txtbox1").DrawingObject.Text = First_Row_Filtered Then
    ActiveSheet.Shapes("Cardcounter").TextFrame.Characters.Text = 1
    Else
    counter = counter + 1
    End If



End Sub

編輯：實際上，我剛剛意識到，當您重新打開文檔時，第一個結果顯示為1，正確，但是第二個結果顯示為0，然后從那里開始計數

EDIT2：根據以下響應，使用修改后的代碼更新帖子：

Public Sub GetNextResult()



    Call FilterData


    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Database")


    Dim header As String
    header = "txtbox1"

    Dim LastRow As Long
    LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row



    Dim DataRange As Range
    Set DataRange = ws.Range("A5", "J" & LastRow)


    Dim FilteredData As Range
    Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)



    First_Row_Filtered = Range("C6:C" & Rows.Count).SpecialCells(xlVisible)(1).Value



    If CurrentRow + 1 > FilteredData.Cells.Count Then
        CurrentRow = 1
    End If




    CurrentRow = CurrentRow + 1




    Dim i As Long
    Dim cell As Variant
    Static counter As Long



    ActiveSheet.Shapes("Cardcounter").TextFrame.Characters.Text = counter







    For Each cell In FilteredData


        i = i + 1
        If i = CurrentRow Then
            Call ShowAll


            TextboxName = "txtbox1"
            ActiveSheet.Shapes(TextboxName).DrawingObject.Text = cell.Offset(0, 2)

            TextboxName2 = "txtbox2"
            ActiveSheet.Shapes(TextboxName2).DrawingObject.Text = cell.Offset(0, 3)

            TextboxName3 = "txtbox3"
            ActiveSheet.Shapes(TextboxName3).DrawingObject.Text = cell.Offset(0, 4)


            If ActiveSheet.Shapes(TextboxName).DrawingObject.Text = header Then


                Call GetNextResult
            End If

            Call quick_artwork


        Else
            Call ShowAll


        End If



    Next cell



    If ActiveSheet.Shapes("txtbox1").DrawingObject.Text = First_Row_Filtered Then
    ActiveSheet.Shapes("Cardcounter").TextFrame.Characters.Text = 1
    counter = 2
    Else
    counter = counter + 1
    End If



End Sub

剩下的最后兩個問題是：

1. 當計數器應該重置時，它實際上又增加了半秒，然后THEN重置為1。我想知道是否有辦法使它立即發生？

編輯：現在已解決，請參閱響應

2. 這實際上與計數器沒有關系，但是由於某些原因，第一次單擊按鈕時，GetNextResult按鈕將始終插入第二個結果，而不是第一個結果。 因此，如果您更改了條件，則將插入到文本框中的第一個結果是已過濾數據的第二行，而不是第一行。 知道為什么嗎？

Answer 1

您的If語句不會重置counter變量。 考慮將您的Then語句更改為僅使counter = 1

    If ActiveSheet.Shapes("txtbox1").DrawingObject.Text = First_Row_Filtered Then counter = 1