VBA按升序复制粘贴日期

Question

我已从工作表查询复制日期并粘贴到工作表投影。我需要按升序粘贴日期，但代码给了我随机顺序。你能修复我的代码以获得正确排序的日期吗？提前致谢！

这是我当前的输出

代码如下：

Sub code()
    Sheets("Projection").Cells.Clear
    Dim ws1 As Worksheet: Set ws1 = Worksheets("Query")
    Dim ws2 As Worksheet: Set ws2 = Worksheets("Projection")
    Dim lRow As Long, x As Long, lRow2 As Long, i As Long, c As Long
    Dim dts As Variant
           
    lRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row
    dts = ws1.Range("D2:D" & lRow) 

    With CreateObject("Scripting.Dictionary")
        For x = LBound(dts) To UBound(dts)
            If Not IsMissing(dts(x, 1)) Then .Item(dts(x, 1)) = 1
        Next
        dts = .Keys
    End With

    ws2.Range("C1").Resize(, UBound(dts) + 1) = dts 
    ws1.Range("A1:B" & lRow).Copy ws2.Range("A1") 
    ws2.Range("A1:B" & lRow).RemoveDuplicates Columns:=Array(1, 2), _
        Header:=xlNo 
    lRow2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
  
    For c = 3 To 3 + UBound(dts)
        For i = 2 To lRow2
            ws2.Cells(i, c) = Application.WorksheetFunction.SumIfs _
            (ws1.Range("F:F"), ws1.Range("D:D"), ws2.Cells(1, c), _
            ws1.Range("B:B"), ws2.Range("B" & i)) 
        Next
    Next
    ws2.Columns.AutoFit
End Sub

Answer 1

从https://wellsr.com/vba/2018/excel/vba-bubble-sort-macro-to-sort-array/复制BubbleSort Sub

然后这样做：

'...
'...
BubbleSort dts
ws2.Range("C1").Resize(, UBound(dts) + 1) = dts 
'...
'...