VBA-将范围增加1小时

Question

我在UTC时间中获得了一些时间和日期值-它们看起来像是yyyy-mm-dd HH：mm：ss：fff UTC，例如：

2018-07-13 10:01:11.427 UTC
2018-07-13 10:01:10.612 UTC
2018-07-13 10:01:03.931 UTC
2018-07-13 10:00:58.201 UTC
2018-07-13 10:00:55.298 UTC

我正在使用文本到列中以截断UTC部分，我需要将结果日期和时间转换为CET，所以我只需要向其中添加一个小时。

我想出了以下代码，但无法正常工作。有人可以帮我解决这个问题吗？

Sub CET_Time()
    Dim LastRow 
    LastRow = ActiveSheet.UsedRange.Rows.Count
    With Range("A2:A" & LastRow)
        .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(19, 9)), TrailingMinusNumbers:=True
    End With
    Range("B2:B" & LastRow).Value = DateAdd("h", 1, Range("B2:B" & LastRow).Value)
End Sub

Answer 1

正如@Tom所建议的那样，由于DateAdd将日期作为第三个参数，而现在您要传递的是Range，这是一种完全不同的类型，因此您可能会在范围内循环。

For Each rngCell in Range("B2:B" & LastRow)
    rngCell.value = DateAdd("h", 1, rngCell.Value)
Next rngCell

这仍然可能失败，因为它通过了string而不是date，但是它可以按原样工作，而无需进行任何修改（未经测试）。

经过测试，几乎肯定需要将日期字符串转换为日期。您可以使用cdate()来做到这一点：

For Each rngCell in Range("B2:B" & LastRow)
    rngCell.value = DateAdd("h", 1, cdate(rngCell.Value))
Next rngCell

Answer 2

循环没问题，但是我喜欢数组：

Sub CET_Time()
    Dim LastRow As Long
    LastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
    With ActiveSheet.Range("A2:A" & LastRow)
        .Offset(, 1).Value = ActiveSheet.Evaluate("INDEX(left(" & .Address(1, 1) & ",23)+1/24,)")
        .Offset(, 1).NumberFormat = "YYYY-MM-DD HH:MM:SS.000"
    End With
End Sub

如果您只想覆盖原位，请同时删除两个.Offset( ,1)

Answer 3

我有这个建议，它可以完成工作：

Dim LastRow As Long
Dim RLoop As Long
LastRow = ActiveSheet.UsedRange.Rows.Count
With Range("A2:A" & LastRow)
    .TextToColumns Destination:=Range("B2"), DataType:=xlFixedWidth, _
    FieldInfo:=Array(Array(0, 1), Array(19, 9)), TrailingMinusNumbers:=True
End With
For RLoop = 2 To LastRow
If IsDate(Range("B" & RLoop).Value) Then
Range("B" & RLoop).Value = DateAdd("h", 1, Range("B" & RLoop).Value)
End If
Next RLoop

我还是想知道我是否可以通过使用范围来达到相同的效果-与循环相比，我对此感到更自在...

Answer 4

最简单的方法是编写一个为您增加值的函数。

Sub CET_Time2()
    Dim cell As Range
    Dim results As Variant
    With ActiveSheet
        For Each cell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            If cell.value Like "####-##-## ##:##:##.### UTC" Then
                cell.Offset(0, 2).value = getUTCTime1Hour(cell.value)
            End If
        Next
    End With
End Sub

Function getUTCTime1Hour(value As Variant) As String
    Dim d As Date
    If value Like "####-##-## ##:##:##.### UTC" Then
        d = DateValue(Left(value, 16)) + TimeValue(Left(value, 16))
        d = d + TimeSerial(1, 0, 0)
        getUTCTime1Hour = Format(d, "YYYY-MM-DD HH:MM") & Right(value, 8)
    End If
End Function