问题
I have a userform with a listbox that displays data from a worksheet. I am wanting to get that data to display in the listbox by current date and time. So when a user enters new data he/she sees the most current lines of data. This is to help the user so they don't enter duplicate information.
I am hoping this can be accomplished programmatically because in the near future this form will be linked to a database not a worksheet.
Here is the code to populate my listbox:
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
And the code to reload my listbox when the save button is clicked by calling "RefreshListbox" :
Private Sub RefreshListbox()
With ListBox1
.RowSource = "Table1!A3:T100"
.ColumnCount = 20
.ColumnHeads = True
End With
End Sub
Screen shot of my userform: UserForm Screen Shot
回答1:
Referred to Date Array Sort and Populating listbox from array
Public declaration of an array variable in a module
Public Dtarr(1 To 8) As Date
One can redim the array size in a macro to resize it to the table size.
Following is the dates table
Added following procedure in a module to sort a date array.
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
Added following procedure to the userform
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
So, the output is the descending order sorted listbox. The user can always see the latest record time at the top.
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Editing answer as per your comment below
XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Following is the sample data in A1:T13.
Following is userform code. You can specify the data range (arrData
) in the userform code.
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
Following is Module1 code to sort the Dtarr. Please note Public Dtarr()
in the code
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
So, the output is the descending order sorted listbox. The user can always see the latest record time at the top.
来源:https://stackoverflow.com/questions/61530566/listbox-sort-filter-by-date-time-in-vba-userform