问题描述
由于重新安装了Windows（不同的语言），因此某些日志文件现在具有不同的DateTime格式。
为了使我的Excel / VBA脚本再次工作，我必须将DateTime字符串转换为恒定长度的旧（德语）时间格式。
明确说明：我想操作字符串（不获取其他数据类型）。
Problematic Format => Wanted Format
"12/28/2019 9:37:49 PM" => "28.12.2019 21:37:49"
"1/2/2020 10:15:20 AM" => "02.01.2020 10:15:20"
"2/1/2020 7:10:15 AM" => "01.02.2020 07:10:15"
"2/13/2020 7:10:15 AM" => "13.02.2020 07:10:15"
我面临的一个问题是“问题格式”的字符串长度可变。这意味着我无法使用LEFT / MID / RIGHT在此字符串中提取特定位置。
是否可以轻松地将此字符串转换为无循环的旧格式？
由于Excel的行为异常/不一致，因此以下代码无法正常工作：
ProblematicFormat$ = "2/1/2020 7:10:15 AM"
MyDate = CDate(ProblematicFormat$)
NewDateTime$ = Format(MyDate,"dd.MM.yyyy H:nn:ss")
MsgBox NewDateTime$
"2/1/2020 7:10:15 AM" => "02.01.2020 07:10:15" (wrong)
"2/13/2020 7:10:15 AM" => "13.02.2020 07:10:15" (correct)
解决方法
关于字符串操作，请尝试以下代码：
Sub testDateFormatLocale()
Dim ProblematicFormat$,replacement$,toReplace$,MyDate As Date,NewDateTime$,CorrectDateTime$
'Debug.Print Now,Format(Now,"dd\/mm\/yyyy hh:nn:ss")
ProblematicFormat$ = "2/13/2020 7:10:15 AM"
MyDate = CDate(ProblematicFormat$) 'm/dd/yyyy
NewDateTime$ = Format(MyDate,"dd.MM.yyyy H:nn:ss")
Debug.Print NewDateTime$
replacement = Split(NewDateTime,".",3)(1) & "." & Split(NewDateTime,3)(0)
toReplace = Split(NewDateTime,3)(0) & "." & Split(NewDateTime,3)(1)
CorrectDateTime$ = Replace(NewDateTime$,toReplace,replacement)
Debug.Print CorrectDateTime$
End Sub
您只能将以上解决方案用于德语本地化。可以使用：
Debug.Print Application.International(xlCountrySetting)
解决方案在于区域和语言设置。在格式标签中，将格式更改为美国（ mm / dd / yyyy ）。如果您不想更改区域设置，则必须使用Split/Dateserial处理上述日期，然后您将获得所需的内容。像这样...
Option Explicit
Sub Sample()
Dim oldDateString As String
Dim newDateString As String
Dim d As Integer
Dim m As Integer
Dim y As Integer
Dim MyDate As Date
oldDateString = "2/1/2020 7:10:15 AM"
oldDateString = Split(oldDateString)(0)
d = Val(Split(oldDateString,"/")(1))
m = Val(Split(oldDateString,"/")(0))
y = Val(Split(oldDateString,"/")(2))
MyDate = DateSerial(y,m,d)
Debug.Print MyDate
newDateString = Format(MyDate,"dd.MM.yyyy H:nn:ss")
Debug.Print newDateString
End Sub
或者您可以使用此功能？这将检查区域设置，然后决定要做什么...
Private Declare Function GetLocaleInfo Lib "kernel32" Alias _
"GetLocaleInfoA" (ByVal Locale As Long,ByVal LCType As Long,_
ByVal lpLCData As String,ByVal cchData As Long) As Long
Private Const LOCALE_USER_DEFAULT = &H400
Private Const LOCALE_SSHORTDATE = &H1F
Private Sub Sample()
Dim LocaleValue As String
Dim RetValue As Long
LocaleValue = Space(255)
RetValue = GetLocaleInfo(LOCALE_USER_DEFAULT,LOCALE_SSHORTDATE,_
LocaleValue,Len(LocaleValue))
'~~> Get short date format
LocaleValue = Ucase(Trim(Left(LocaleValue,RetValue - 1)))
If Left(LocaleValue,1) = "M" Then 'M/d/yyyy ???
'~~> Use your original code
ElseIf Left(LocaleValue,1) = "D" Then
'~~> Use the code that I gave
End If
End Sub
注意：您可能会遇到不同的格式。上面的代码将稍作调整，即可帮助您处理所有这些格式。
,您可以使用此功能“吃掉”甚至很奇怪的美国格式的字符串：
' Converts a US formatted date/time string to a date value.
'
' Examples:
' 7/6/2016 7:00 PM -> 2016-07-06 19:00:00
' 7/6 7:00 PM -> 2018-07-06 19:00:00 ' Current year is 2018.
' 7/6/46 7:00 PM -> 1946-07-06 19:00:00
' 8/9-1982 9:33 -> 1982-08-09 09:33:00
' 2/29 14:21:56 -> 2039-02-01 14:21:56 ' Month/year.
' 2/39 14:21:56 -> 1939-02-01 14:21:56 ' Month/year.
' 7/6/46 7 -> 1946-07-06 00:00:00 ' Cannot read time.
' 7:32 -> 1899-12-30 07:32:00 ' Time value only.
' 7:32 PM -> 1899-12-30 19:32:00 ' Time value only.
' 7.32 PM -> 1899-12-30 19:32:00 ' Time value only.
' 14:21:56 -> 1899-12-30 14:21:56 ' Time value only.
'
' 2018-03-31. Gustav Brock. Cactus Data ApS,CPH.
'
Public Function CDateUs( _
ByVal Expression As String) _
As Date
Const PartSeparator As String = " "
Const DateSeparator As String = "/"
Const DashSeparator As String = "-"
Const MaxPartCount As Integer = 2
Dim Parts As Variant
Dim DateParts As Variant
Dim DatePart As Date
Dim TimePart As Date
Dim Result As Date
' Split expression into maximum two parts.
Parts = Split(Expression,PartSeparator,MaxPartCount)
If IsDate(Parts(0)) Then
' A date or time part is found.
' Replace dashes with slashes.
Parts(0) = Replace(Parts(0),DashSeparator,DateSeparator)
If InStr(1,Parts(0),DateSeparator) > 1 Then
' A date part is found.
DateParts = Split(Parts(0),DateSeparator)
If UBound(DateParts) = 2 Then
' The date includes year.
DatePart = DateSerial(DateParts(2),DateParts(0),DateParts(1))
Else
If IsDate(CStr(Year(Date)) & DateSeparator & Join(DateParts,DateSeparator)) Then
' Use current year.
DatePart = DateSerial(Year(Date),DateParts(1))
Else
' Expression contains month/year.
DatePart = CDate(Join(DateParts,DateSeparator))
End If
End If
If UBound(Parts) = 1 Then
If IsDate(Parts(1)) Then
' A time part is found.
TimePart = CDate(Parts(1))
End If
End If
Else
' A time part it must be.
' Concatenate an AM/PM part if present.
TimePart = CDate(Join(Parts,PartSeparator))
End If
End If
Result = DatePart + TimePart
CDateUs = Result
End Function
然后应用您的格式，例如：
? Format(CDateUS("1/2/2020 10:15:20 AM"),"dd.mm.yyyy hh:nn:ss")
02.01.2020 10:15:20