简体   繁体   中英

How can I sort dates in an array in vba?

Hi I am new to programming and just started learning VBA for excel. I have a query regarding sorting of arrays. How do I sort an array containing dates? For example if I have an array containing the dates ("23-jul-13","11-jan-10","1-may-09","3-feb-04") how do I sort this array. I have searched all over the internet for answers but could only find code for sorting numbers. I have been racking my brains on this for 2 days but can't seem to get it.

Thanks

I have the code below which takes dates from a selected column but I am getting an error whenever I run it. I have been trying to figure out what's wrong with it for 2 days now. I didn't mention this code earlier as I though it would unnnecessarily add to the confusion. The sub GetUniqueAndCount works fine but it's the sort sub which is the problem as it doesn't accept the array passed to it as an argument.

Sub GetUniqueAndCount()
Dim d As Object, c As Range, k, tmp As String

  Set d = CreateObject("scripting.dictionary")
  'I will select the column of dates
 For Each c In Selection
  tmp = Trim(c.Value)
  If Len(tmp) > 0 Then
  If Year(DateValue(Format(tmp, "dd-mmm-yy"))) = 2013 Then
  d(tmp) = d(tmp) + 1
  End If
  End If
  Next c
  i = 0
  ReDim ThisArray(UBound(d.keys)) As Date
  For Each k In d.keys
  ThisArray(i) = DateValue(Format(k, "dd-mmm-yy"))
  i = i + 1

  Next k
  Sort (ThisArray)
End Sub


Sub Sort(arr() As Date)

  Dim Temp As Date
  Dim i As Long
  Dim 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
  arr(i + 1) = arr(i)

  Next i
  i = 0
10  arr(i + 1) = Temp


  Next j
  End Sub

Your Sort(arr() As Date) works fine. The problem is with this line

Sort (ThisArray)

Change it to

Sort ThisArray

Also since you are storing Dates in ThisArray , I hope you have declared it as Date ?

Example

Sub Sample()
    Dim ThisArray(1 To 5) As Date

    ThisArray(1) = #12/13/2013#
    ThisArray(2) = #12/13/2012#
    ThisArray(3) = #12/13/2015#
    ThisArray(4) = #12/13/2014#
    ThisArray(5) = #12/13/2016#

    SortAr ThisArray

    For i = 1 To 5
        Debug.Print ThisArray(i)
    Next i
End Sub

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
                arr(i + 1) = arr(i)
        Next i
        i = 0
10:     arr(i + 1) = Temp
    Next j
End Sub

OUTPUT

13/12/2012 
13/12/2013 
13/12/2014 
13/12/2015 
13/12/2016 

This might help. fell free to ask a follow up question.

Sub Sort()
Dim x As Long, y As Long, z As Long
    For x = Application.WorksheetFunction.Min(Columns("M")) To Application.WorksheetFunction.Max(Columns("M"))
        For y = 1 To Worksheets("Users Info").Cells(Rows.Count, 13).End(xlUp).Row
        If Worksheets("Users Info").Cells(y, 13).Value = i Then
            z = z + 1
            Worksheets("Users Info").Cells(z, 14).Value = i
        End If
        Next y
    Next x
End Sub

I used different two ways to fill dates to drop-down lists on sheet as uniquelly and the sorted oldest to newest values :

  • First way , using Adodb Connection.
  • Second way , using Scripting Dictionary object and a user-defined function.

Adodb connection codes that I used :

Dim con, rs As Object, sorgu As String
Set con = CreateObject("adodb.connection")
Sheets("Page1").ComboBox1.Clear
Sheets("Page1").ComboBox2.Clear
    
    #If VBA7 And Win64 Then
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=yes"""
    #Else
con.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
    #End If
          
Set rs = CreateObject("adodb.recordset")
sorgu = "select Date from [Page1$] group by Date"
rs.Open sorgu, con, 1, 1
While Not rs.EOF
Sheets("Page1").ComboBox1.AddItem Format(rs("Date").Value, "dd.mm.yyyy")
Sheets("Page1").ComboBox2.AddItem Format(rs("Date").Value, "dd.mm.yyyy")
rs.movenext
Wend
rs.Close
con.Close

在此处输入图片说明

Source

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM