如何在vba中对数组中的日期进行排序？

Question

您好我是编程新手，刚开始学习VBA for excel。我有关于数组排序的查询。如何对包含日期的数组进行排序？例如，如果我有一个包含日期的数组（＆＃34; 23-jul-13＆＃34;，＆＃34; 11-jan-10＆＃34;，＆＃34; 1-may-09＆＃34;， ＆＃34; 3-feb-04＆＃34;）如何对此数组进行排序。我在互联网上搜索了答案，但只能找到排序数字的代码。我已经绞尽脑汁待了2天，但似乎无法得到它。

由于

我有下面的代码从选定的列中获取日期，但每次运行时都会收到错误。我一直试图弄清楚它有什么问题。我之前没有提到过这段代码，因为它会不必要地增加混乱。 子GetUniqueAndCount工作正常，但它是sort的问题，因为它不接受作为参数传递给它的数组。

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

Answer 1

您的Sort(arr() As Date)工作正常。问题在于这一行

Sort (ThisArray)

将其更改为

Sort ThisArray

此外，由于您将Dates存储在ThisArray中，我希望您已将其声明为Date？

示例

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

<强>输出

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

Answer 2

这可能会有所帮助。随意提出跟进问题。

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