Question

我试图按照时间顺序对给定范围进行排序，而不是按照A列中的值按升序排序

下面的代码检查是否在B到Z的列中更改了任何值，并将日期和时间放在col A中的相应单元格行中。

此宏的目的是将最后编辑的行放在表格的底部。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cel As Range
    Dim m As Long
    Dim DataRange As Range
    Dim keyRange As Range
    Set DataRange = Range("A2:Z1048567")
    Set keyRange = Range("A2")

    Application.ScreenUpdating = False
       For Each Cel In Target
        If Not Intersect(Target, Cel) Is Nothing And Cel.Column > 1 And Cel.Column <= 26 Then
            m = Cel.Row
            With ActiveSheet.Range("A" & m)
                .Value = Date & " " & Time
                .NumberFormat = "dd/mm/yyyy hh:mm AM/PM "
            End With
            DataRange.Sort Key1:=keyRange, Order1:=xlAscending
            Application.ScreenUpdating = True
            Exit Sub
        End If
       Next Cel

Application.ScreenUpdating = True
End Sub

Answer 1

除非您有左侧单元格对齐的强制，否则A列中的日期时间实际上是“文本看起来像日期时间”。最重要的是，它们处于DMY配置状态，VBA非常以EN-US为中心（即MDY），无论计算机的区域系统设置是针对日期设置的。

您可以使用 CDate 等转换例程，但结果不可靠。如果是18/01/2016 10:08:52 AM这样的明确日期，则转换将是正确的。但是，如果您的日期时间不明确，例如06/01/2016 10:08:52 AM，那么CDate转换很可能会返回01-Jun-2016 10:08:52而不是“正确的”06-Jan-2016 10:08:52。需要将时间拆分为未使用的列，然后将其组合回修复日期。

使用Range.TextToColumns method命令并使用xlColumnDataType强制进行正确的DMY日期转换。

首先选择所有日期，对现有数据运行此例程。不要包含列标题标签，因为它比日期的第一个分割点长。首先选择A2然后点击 Ctrl + Shift + ▼应该很好。

Sub repair_Dates_by_Selection()
    Dim dt As Range
    With Intersect(Selection, Selection.Parent.UsedRange)
        .Columns(1).Offset(0, 1).EntireColumn.Insert
        .TextToColumns Destination:=.Cells(1), DataType:=xlFixedWidth, _
                       FieldInfo:=Array(Array(0, 4), Array(10, 1))
        For Each dt In .Cells
            dt = dt.Value2 + dt.Offset(0, 1).Value2
        Next dt
        .Columns(1).Offset(0, 1).EntireColumn.Delete
        .NumberFormat = "dd/mm/yyyy hh:mm AM/PM"
    End With
End Sub

完成此操作后，A列中的日期时间应为实际日期，实时格式为DMY配置。

<强> Worksheet_Change

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Columns("B:Z")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Application.ScreenUpdating = False
        Dim cel As Range
        For Each cel In Intersect(Target, Columns("B:Z"))
            With cel
                Debug.Print "!" & cel.Address
                If .Row > 1 Then
                    Intersect(Columns(1), cel.EntireRow).Value = Now
                    .NumberFormat = "dd/mm/yyyy hh:mm AM/PM_);@"
                End If
            End With
        Next cel
        With Cells(1, 1).CurrentRegion
            .Cells.Sort Key1:=.Columns(1), Order1:=xlAscending, _
                        Orientation:=xlTopToBottom, Header:=xlYes
        End With
    End If

bm_Safe_Exit:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

上面添加了禁用/启用原始代码的事件。 Intersect method用于确定适用的单元格。 Now用于为时间戳创建真实的日期时间，而不是text-that-looking-a-datetime。前者可以按时间顺序轻松排序，后者充其量是不可靠的。

如何按时间顺序排序范围vba

1 个答案: