[英]Excel VBA convert Date with time
I have 2 cells with time data that format as follows:我有 2 个带有时间数据的单元格,其格式如下:
"A1" = Sep 01 2018 00:01:33.707
"A2" = Sep 01 2018 00:01:49.917
I need to create a button and method within excel VBA that will set "A3" cell to true if the time "A2" is more than "A1" by 90 seconds.我需要在excel VBA中创建一个按钮和方法,如果时间“A2”比“A1”多90秒,则将“A3”单元格设置为true。 This is what i have so far but it does not work:
这是我到目前为止所拥有的,但它不起作用:
Sub Macro2()
Dim str1 As String, str2 As String
With Worksheets("sheet5")
str1 = .Cells(1, "A").Text
str2 = .Cells(2, "A").Text
'greater than 90m seconds in A3
.Cells(3, "A") = CBool(Abs((DateValue(Left(str1, 6) & "," & Mid(str1, 7, 5)) + _
TimeValue(Mid(str1, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str1, 4))) - _
(DateValue(Left(str2, 6) & "," & Mid(str2, 7, 5)) + _
TimeValue(Mid(str2, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str2, 4)))) > _
TimeSerial(0, 0, 90))
'actual absolute difference in A4
.Cells(4, "A") = Abs((DateValue(Left(str1, 6) & "," & Mid(str1, 7, 5)) + _
TimeValue(Mid(str1, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str1, 4))) - _
(DateValue(Left(str2, 6) & "," & Mid(str2, 7, 5)) + _
TimeValue(Mid(str2, 13, 8)) + TimeSerial(0, 0, 1) * CDbl(Right(str2, 4))))
End With End Sub
The above gives error because Date functions works with system Locale, which in my case is Hebrew, while the Data is in English.上面给出了错误,因为日期函数适用于系统语言环境,在我的情况下是希伯来语,而数据是英语。
Another way that could help is to convert all the column "A" (which holds the dates) to a system local date that can be used with Date and time functions on VBA (don't know how to do that).另一种可能有帮助的方法是将所有列“A”(保存日期)转换为可与 VBA 上的日期和时间函数一起使用的系统本地日期(不知道如何执行)。
Please help请帮忙
I have split your task into 3 functions.我已将您的任务分为 3 个功能。
a) a helper function converts the 3 characters of the month into an integer. a) 辅助函数将月份的 3 个字符转换为整数。 It looks a little clumsy, there might be other approaches but the advantage of using a large
Select Case
is it is easy to understand and easy to adapt if month names in a different language arise:它看起来有点笨拙,可能还有其他方法,但使用大型
Select Case
的优点是,如果出现不同语言的月份名称,则易于理解和适应:
Function getMonthFromName(monthName As String) As Integer
Select Case UCase(monthName)
Case "JAN": getMonthFromName = 1
Case "FEB": getMonthFromName = 2
Case "MAR": getMonthFromName = 3
Case "APR": getMonthFromName = 4
(...)
Case "SEP": getMonthFromName = 9
(...)
End Select
End Function
b) a function that converts the string into a date. b) 将字符串转换为日期的函数。 It assumes the date format in the form you provided, but it is easily adapted if the format changes (for simplicity, the seconds are rounded)
它采用您提供的形式的日期格式,但如果格式发生变化,它很容易适应(为简单起见,秒四舍五入)
Function GetDateFromString(dt As String) As Date
Dim tokens() As String
tokens = Split(Replace(dt, ":", " "), " ")
Dim day As Integer, month As Integer, year As Integer
month = getMonthFromName(CStr(tokens(0)))
day = Val(tokens(1))
year = Val(tokens(2))
Dim hour As Integer, minute As Integer, second As Double
hour = Val(tokens(3))
minute = Val(tokens(4))
second = Round(Val(tokens(5)), 0)
GetDateFromString = DateSerial(year, month, day) + TimeSerial(hour, minute, second)
End Function
c) A function that calculated the difference of the 2 dates in seconds. c) 以秒为单位计算两个日期差的函数。 A date in VBA (and many other environments) is stored as
Double
, where the Date-Part is the integer part and the date is the remainder. VBA(和许多其他环境)中的日期存储为
Double
,其中 Date-Part 是整数部分,日期是余数。 This makes it easy to calculate with Date values.这使得使用日期值计算变得容易。
Function DateDiffInSeconds(d1 As String, d2 As String) As Long
Dim diff As Double
diff = GetDateFromString(d2) - GetDateFromString(d1)
DateDiffInSeconds = diff * 24 * 60 * 60
End Function
Update to deal with milliseconds: Change the GetDateFromString
-function.更新以处理毫秒:更改
GetDateFromString
函数。 In that case, DateDiffInSeconds
should return a double
rather than a long
.在这种情况下,
DateDiffInSeconds
应该返回double
而不是long
。
Function GetDateFromString(dt As String) As Date
Const MillSecPerHour As Long = 24& * 60 * 60 * 1000
Dim tokens() As String
tokens = Split(Replace(Replace(dt, ".", " "), ":", " "), " ")
Dim day As Integer, month As Integer, year As Integer
month = getMonthFromName(CStr(tokens(0)))
day = Val(tokens(1))
year = Val(tokens(2))
Dim hour As Integer, minute As Integer, second As Integer, milli As Integer
hour = Val(tokens(3))
minute = Val(tokens(4))
second = Val(tokens(5))
milli = Val(tokens(6))
GetDateFromString = DateSerial(year, month, day) _
+ TimeSerial(hour, minute, second) _
+ milli / MillSecPerHour
End Function
I think you are over-complicating it, try this to get an idea how to do it:我认为你把它复杂化了,试试这个来了解如何做到这一点:
Sub Macro2()
Dim str1 As String, str2 As String
With Worksheets("sheet5")
.Range("b1:e1") = Split(Range("A1"), " ")
.Range("B2:e2") = Split(Range("A2"), " ")
End Sub
For your information, I've done what you are doing in a slightly different (and easier) way:为了您的信息,我以稍微不同(且更简单)的方式完成了您正在做的事情:
In cell B2, I put the value 13/11/2018 11:44:00
.在单元格 B2 中,我输入值
13/11/2018 11:44:00
。
In cell B3, I put the value 13/11/2018 11:45:01
.在单元格 B3 中,我输入值
13/11/2018 11:45:01
。
(For both cells, the cell formatting has been set to d/mm/jjjj u:mm:ss
). (对于这两个单元格,单元格格式已设置为
d/mm/jjjj u:mm:ss
)。
In another cell, I put following formula:在另一个单元格中,我输入了以下公式:
=IF((B3-B2)*86400>90;TRUE;FALSE)
The formula is based on the idea that a datetime value is set, based on the idea that one day equals 1, and there are 86400 seconds in one day.该公式基于设置日期时间值的思想,基于一天等于1的思想,一天有86400秒。
Like this, you can calculate time differences without needing VBA.像这样,您可以在不需要 VBA 的情况下计算时差。
Use UDF.使用 UDF。
Sub Macro2()
Dim str1 As String, str2 As String
Dim mySecond As Double, t1 As Double, t2 As Double, t3 As Double
mySecond = TimeSerial(0, 0, 90)
With Worksheets("sheet5")
str1 = .Cells(1, "A").Text
str2 = .Cells(2, "A").Text
t1 = ConvertTime(str1)
t2 = ConvertTime(str2)
t3 = t2 - t1
.Cells(3, "a") = Abs(t3) >= mySecond
End With
End Sub
Function ConvertTime(s As String)
Dim vS
vS = Split(s, " ")
ConvertTime = DateValue(vS(0) & "-" & vS(1) & "-" & vS(2)) + TimeValue(Split(vS(3), ".")(0))
End Function
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.