Excel VBA按日期自动排序

时间:2016-12-08 15:45:22

标签: excel vba excel-vba date macros

我是编写宏或使用VBA的新手,我遇到了一个希望很容易修复的问题。我目前正在使用Excel中的项目,在单击附加了宏的按钮后,将允许我根据L列中的值(1a或1b)将数据从一个主表复制并粘贴到另外两个主表上我到目前为止的宏(包含在下面)与复制/粘贴元素配合得很好,但是我希望复制的数据在粘贴时按日期和时间(列J)从最旧到最新自动排序进入目的地表。日期/时间格式为MM / DD / YY HH:MM AM或PM。

Sub EGS_CVS_Sorting()
Dim lr As Long, lr2 As Long, r As Long

    lr = Sheets("template").Cells(Rows.Count, "L").End(xlUp).Row

    For r = lr To 2 Step -1

        Select Case Sheets("template").Range("L" & r).Value
            Case Is = "1a"
                lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row
                Sheets("template").Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1)

            Case Is = "1b"
                lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row
                Sheets("template").Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1)
        End Select

    Next r

End Sub

谢谢!

2 个答案:

答案 0 :(得分:0)

在谷歌的vba excel排序中没有541000个调查结果没有抓住你的兴趣吗? 检查这是否会引导您朝正确的方向前进,但要调整您要排序的数据的范围,检查标题等:

/dev

答案 1 :(得分:0)

编写宏来执行之前未编码的任务的一个很好的起点就是简单地记录一个执行您想要完成的任务的宏。因此,如果我从一个在J列中有日期的样本数据集开始,我开始记录一个宏,按列J对数据进行排序,停止记录,然后查看代码。我明白了:

Sub Sorter()
'
' Sort Macro
'

'
    Range("J1").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:= _
        Range("J1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("All Active Clients").Sort
        .SetRange Range("F2:J23")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

这手动编码我选择了单元格J1,然后显示排序功能经历的步骤。由此,我可以缩小我实际想做的事情。例如,选择J1是不必要的,我不需要担心.sortmethod等。我可以将代码修改为类似以下内容:

Sub Sorter()
'
' Sort Macro
'

'
    Const csDateSt As String = "J1"

    Dim shtSort As Worksheet
    Dim rngSort As Range

    Set shtSort = Sheets("Sheet1")
    Set rngSort = shtSort.UsedRange

    With shtSort.Sort
        .SortFields.Clear
        .SortFields.Add Key:= _
                        Range(csDateSt), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending
        .SetRange rngSort
        .Header = xlNo
        .Apply
    End With
End Sub

我所做的就是重新组织录制的代码,将一些硬编码值更改为常量和变量,并将它们全部放在With块中。我现在可以将其用作路线图,在任何需要的地方放置相同类型的结构。

你甚至可以将你的排序过程保持为一个单独的Sub,并在需要时调用它,传递参数以告诉它数据的位置,因此:

Sub Sorter(ByVal shtSort As Worksheet, ByVal rngSort As Range, ByVal strKey As String)
    With shtSort.Sort
        .SortFields.Clear
        .SortFields.Add Key:= _
                        Range(strKey), _
                        SortOn:=xlSortOnValues, _
                        Order:=xlAscending
        .SetRange rngSort
        .Header = xlNo
        .Apply
    End With
End Sub

然后在你的循环中你会说出以下内容:

    Select Case Sheets("template").Range("L" & r).Value
        Case Is = "1a"
            lr2 = Sheets("EGS lines").Cells(Rows.Count, "L").End(xlUp).Row
            Sheets("template").Rows(r).Copy Destination:=Sheets("EGS lines").Range("A" & lr2 + 1)

        Case Is = "1b"
            lr2 = Sheets("CVS lines").Cells(Rows.Count, "L").End(xlUp).Row
            Sheets("template").Rows(r).Copy Destination:=Sheets("CVS lines").Range("A" & lr2 + 1)
    End Select

Call Sorter(Sheets("EGS Lines"),Sheets("EGS Lines").range("A1").currentregion, "J1")
Call Sorter(Sheets("CVS Lines"),Sheets("CVS Lines").range("A1").currentregion, "J1")