VBA 按升序复制粘贴日期

问题描述

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

这是我当前的输出

代码如下：

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

解决方法

暂无找到可以解决该程序问题的有效方法，小编努力寻找整理中！

如果你已经找到好的解决方法，欢迎将解决方案带上本链接一起发送给小编。

小编邮箱:dio#foxmail.com (将#修改为@）

bounds date