Повторите активный фильтр после ввода пользовательской формы

Question

У меня есть макрос, который сортирует клиентов по «контактным датам», «депозитам» и «кредитам». Скажем, я выбираю сортировку по «Дате контакта», а затем добавляю нового клиента в свой список, как я могу выполнить повторную сортировку active после ввода нового клиента из моей формы пользователя?

Форма пользователя, которую я использую для добавления данных клиента

Параметры фильтра

Вот мой код:

Кредитный баланс сортировать

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

Дата контакта Сортировка

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

Депозит Баланс Сортировка

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

Небольшой код, который вы показали, очень избыточен - делая жестко заданный аргумент Key1 sort параметром, вы мгновенно устраняете необходимость в двух из этих трех клонов и перенаправляете третий для выполнения работы для всех три.

Сортировка и применение сортировки - это что-то очень простое, когда ваш диапазон - ListObject он же "таблица". Возьмите свой диапазон, выберите «формат таблицы» на домашней ленте. Теперь вам больше не нужно работать над последним рядом.

Кроме того, если лист wss(w) существует в ThisWorkbook во время компиляции, нет никаких причин для его удаления из коллекции Worksheets - просто используйте его кодовое имя идентификатор (вы можете изменить выбрав лист в Project Explorer / Ctrl + R, затем изменив его свойство (Name) в Свойства toolwindow / F4) - тогда вы можете сделать TheSheetName.Range("whatever"). Или лучше - поскольку этот код должен работать только на конкретном листе, поместите его в код позади этого листа и используйте 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"

А если вы хотите повторно применить текущую сортировку:

TheSheetName.ApplySortOrder

И в тот день, когда вам нужно отсортировать что-то еще, вы можете просто сделать:

TheSheetName.ApplySortOrder "ThatFancyNewColumn"

И покончим с этим, без необходимости копировать-вставлять еще одну процедуру.

Вы могли бы даже объявить 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-летние столбцы, как они пожелают. ... но это для другого поста, я думаю.