Список сортировки / фильтрации по дате и времени в пользовательской форме vba?

Question

У меня есть пользовательская форма со списком, который отображает данные из рабочего листа. Я хочу, чтобы эти данные отображались в списке по текущей дате и времени. Поэтому, когда пользователь вводит новые данные, он / она видит самые последние строки данных. Это поможет пользователям не вводить дублирующую информацию.

Я надеюсь, что это можно сделать программным путем, поскольку в ближайшем будущем эта форма будет связана с базой данных, а не с рабочим листом.

Вот код для заполнения моего списка:

    Private Sub UserForm_Initialize() 'Sets variables when the userform initializes

    Call MakeFormResizeable(Me)

    Me.tbDate.Value = Format(Now(), "mm/dd/yyyy hh:mm")

     With ListBox1
        .RowSource = "Table1!A3:T100"
        .ColumnCount = 20
        .ColumnHeads = True
    End With
   End Sub

И код для перезагрузки моего списка при нажатии кнопки сохранения путем вызова «RefreshListbox»:

   Private Sub RefreshListbox()
       With ListBox1
         .RowSource = "Table1!A3:T100"
         .ColumnCount = 20
         .ColumnHeads = True
      End With
   End Sub

Снимок экрана моей пользовательской формы: Снимок экрана пользовательской формы

Answer 1

Ссылка на Дата Сортировка массива и Заполнение списка из массива

Публикация c объявление переменной массива в модуле Public Dtarr(1 To 8) As Date Можно повторить размер массива в макросе, чтобы изменить его размер до размера таблицы.

Ниже приведена таблица дат

Добавлена ​​следующая процедура в модуле для сортировки массива дат .

Sub SortAr(arr() As Date)
    Dim Temp As Date
    Dim i As Long, j As Long

    For j = 2 To UBound(arr)
        Temp = arr(j)
        For i = j - 1 To 1 Step -1
            If (arr(i) >= Temp) Then GoTo 10
' ">" sorts in descending order.
' "<" sorts in ascending order.
                arr(i + 1) = arr(i)
        Next i
        i = 0
10:         arr(i + 1) = Temp
    Next j
End Sub

Добавлена ​​следующая процедура для пользовательской формы

Private Sub UserForm_Initialize()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Sheet2")

For i = 1 To 8
Dtarr(i) = Sh.Range("A" & i + 3).Value
Next

SortAr Dtarr
ListBox1.List = Dtarr

End Sub

Итак, вывод - отсортированный список в порядке убывания. Пользователь всегда может видеть время последней записи вверху.

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Редактирование ответа в соответствии с вашим комментарием ниже под вашим комментарием *

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Ниже приведены примеры данных в A1: T13.

Ниже приведен код пользовательской формы. Вы можете указать диапазон данных (arrData) в коде пользовательской формы.

Private Sub UserForm_Initialize()

Set Sh = ThisWorkbook.Worksheets("Sheet1")
Set AllData = Sh.Range("A1").CurrentRegion
x = AllData.Rows.Count - 1: y = AllData.Columns.Count
Set ListData = AllData.Offset(1, 0).Resize(x, y)

ReDim Dtarr(1 To x, 1 To y)
Dtarr = ListData.Value

Sort2DArr Dtarr, 2 'Second column as you need to sort on Column B

With ListBox1
    .List = Dtarr
    .ColumnCount = y
    .ColumnWidths = "25;100;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25;25"
End With
End Sub

Ниже приведен код Module1 для сортировки Dtarr. Обратите внимание, Public Dtarr() в коде

Option Base 1
Public Sh As Worksheet
Public AllData As Range
Public ListData As Range
Public x As Long
Public y As Long
Public Dtarr()



Sub Sort2DArr(arr(), srtCol As Long)

Dim temp As Date, temparr, srtColArr, temp2 As String
Dim i As Long, j As Long

ReDim temparr(x)
srtColArr = WorksheetFunction.Index(arr, 0, srtCol)
For i = 1 To x
    temparr(i) = Join(Application.Index(arr, i, 0), "~")
Next

temparr = Application.Transpose(temparr)

For j = 2 To x
    temp = srtColArr(j, 1)
    temp2 = temparr(j, 1)
    For i = j - 1 To 1 Step -1
        If (srtColArr(i, 1) >= temp) Then GoTo 10
        ' ">" sorts in descending order.
        ' "<" sorts in ascending order.
        srtColArr(i + 1, 1) = srtColArr(i, 1)
        temparr(i + 1, 1) = temparr(i, 1)
    Next i
        i = 0
10:     srtColArr(i + 1, 1) = temp
        temparr(i + 1, 1) = temp2
    Next j

ReDim Dtarr(1 To x + 1, 1 To y)

For i = 1 To y
    Dtarr(1, i) = AllData(1, i).Value
Next
For i = 2 To x + 1
    tempRow = Split(temparr(i - 1, 1), "~")
    For j = 1 To y
    Dtarr(i, j) = tempRow(j - 1)
    Next
Next
End Sub

Итак, вывод - отсортированный список в порядке убывания. Пользователь всегда может увидеть время последней записи вверху.