用户表单输入后重复活动过滤器

Question

我有一个宏可以根据 "Contact Dates"、"Deposits" 和 "Credit" 对客户端进行排序。假设我 select 按 "Contact Date" 排序，然后我将一个新客户添加到我的列表中，我怎么才能让 active 排序重新运行在我从用户表单输入新客户后？

Userform I use to add client data

Filter Options

这是我的代码：

Credit Balance Sort

Sub creditbalance()

    Dim w As Long, lr As Long, wss As Variant

    wss = Array("contactunder")


    For w = LBound(wss) To UBound(wss)
        With ThisWorkbook.Worksheets(wss(w))
            lr = Application.Max(.Cells(.Rows.Count, "a").End(xlUp).Row, _
                                 .Cells(.Rows.Count, "da").End(xlUp).Row)
            With .Range(.Cells(10, "a"), .Cells(lr, "da"))
                .Cells.Sort Key1:=.Columns(97), Order1:=xlDescending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End With
    Next w

End Sub

Contact Date Sort

Sub contactdate()
    Dim w As Long, lr As Long, wss As Variant

    wss = Array("contactunder")


    For w = LBound(wss) To UBound(wss)
        With ThisWorkbook.Worksheets(wss(w))
            lr = Application.Max(.Cells(.Rows.Count, "a").End(xlUp).Row, _
                                 .Cells(.Rows.Count, "da").End(xlUp).Row)
            With .Range(.Cells(10, "a"), .Cells(lr, "da"))
                .Cells.Sort Key1:=.Columns(2), Order1:=xlDescending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End With
    Next w

End Sub

Deposit Balance Sort

Sub depositbalance()
    Dim w As Long, lr As Long, wss As Variant

    wss = Array("contactunder")


    For w = LBound(wss) To UBound(wss)
        With ThisWorkbook.Worksheets(wss(w))
            lr = Application.Max(.Cells(.Rows.Count, "a").End(xlUp).Row, _
                                 .Cells(.Rows.Count, "da").End(xlUp).Row)
            With .Range(.Cells(10, "a"), .Cells(lr, "da"))
                .Cells.Sort Key1:=.Columns(68), Order1:=xlDescending, _
                            Orientation:=xlTopToBottom, Header:=xlYes
            End With
        End With
    Next w
End Sub

Answer 1

您显示的小代码非常冗余 - 通过将 hard-coded Key1 排序参数作为参数，您立即删除了对这三个克隆中的两个的需要，并重新调整了第三个的用途为所有三个人完成工作。

当您的范围是 ListObject 又名 "table" 时，排序和应用排序是一件非常容易的事情。从主页功能区中获取您的范围 select "format as table"。现在您再也不需要计算最后一行了。

此外，如果 wss(w) sheet 存在于 ThisWorkbook at compile-time，则没有理由从 Worksheets collection 中取消引用它] - 只需使用其代号标识符（您可以通过 select 在 Project Explorer 中输入 sheet 来更改它/ Ctrl+R，然后在 Properties 工具窗口中更改其 (Name) 属性 / F4) - 然后您可以执行 TheSheetName.Range("whatever")。或者更好 - 因为该代码只需要在特定的 sheet 上工作， 将它放在那个 sheet 的 code-behind 中，然后使用 Me 引用 Worksheet 实例：

Public Sub ApplySortOrder(Optional ByVal sortColumn As String = vbNullString)

    With Me.ListObjects(1)

        Dim sortColumnRange As Range
        If sortColumn <> vbNullString Then
            'assumes sortColumn is an existing column header
            Set sortColumnRange = .ListColumns(sortColumn).DataBodyRange
        End If
        With .Sort
            If Not sortColumnRange Is Nothing Then
                .SortFields.Clear
                .SortFields.Add sortColumnRange
            End If
            .Apply
        End With
    End With

End Sub

现在，假设我假设的列标题正确，您调用 depositbalance 的代码可能如下所示：

TheSheetName.ApplySortOrder "DepositBalance"

按 contactdate 排序是这样的：

TheSheetName.ApplySortOrder "ContactDate"

按creditbalance排序：

TheSheetName.ApplySortOrder "CreditBalance"

如果你想re-apply当前排序：

TheSheetName.ApplySortOrder

如果您需要按其他方式排序，您可以这样做：

TheSheetName.ApplySortOrder "ThatFancyNewColumn"

完成它，不需要 copy-paste 另一个程序。

您甚至可以为有效列声明一个 Public Enum...

Public Enum SortingColumn
    Current = 0
    CreditBalance = 97
    DepositBalance = 68
    ContactDate = 2
End Enum

然后更改签名以接受一个 SortingColumn 参数：

Public Sub ApplySortOrder(Optional ByVal sortColumn As SortingColumn = Current)

    With Me.ListObjects(1)

        Dim sortColumnRange As Range
        If sortColumn <> Current Then
            'assumes sortColumn is an existing column header
            Set sortColumnRange = .ListColumns(sortColumn).DataBodyRange
        End If
        With .Sort
            If Not sortColumnRange Is Nothing Then
                .SortFields.Clear
                .SortFields.Add sortColumnRange
            End If
            .Apply
        End With
    End With

End Sub

或者更好的是，省略显式枚举值，并将每个值映射到一个字符串列名 - 然后编写一个函数，为您获取 ListColumn.Index，这样用户就无法重命名标题，但他们仍然可以随意移动这些 90 多列。 ...但我想那是另一个 post。

用户表单输入后重复活动过滤器

Repeat Active Filter After Userform Entry

excel

vba

userform