excel VBA导入时的US日期格式

yxyvkwin  于 2023-04-07  发布在  其他
关注(0)|答案(1)|浏览(174)

血腥恼人的美国日期再次,这一个我还没有看到一个解决方案对我的许多,许多搜索。
我有一些VBA,我发现它可以从我们在底特律的业务合作伙伴生成的一些htm文件中提取数据:

Dim DirPath As String
Dim I_Row As Integer
Dim FilePath As String
Dim xCount As Long
DirPath = ipsosFolder
If DirPath = "" Then Exit Sub
Application.ScreenUpdating = False
FilePath = Dir(DirPath & "\*.htm")
Do While FilePath <> ""
    With ActiveSheet.QueryTables.Add(Connection:="URL;" _
      & DirPath & "\" & FilePath, Destination:=Range("A1"))
    .Name = "a"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .WebSelectionType = xlAllTables
    .WebFormatting = xlWebFormattingNone
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = True
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
    FilePath = Dir
    End With
Loop

(Note .WebDisableDateRecognition = True,这是我修复这个问题的第一个希望,让Excel忽略美国化的日期,直到我能做些什么来修复它们。)
所以这里有美国格式的日期-例如今天是2022年9月21日。现在,这个特定的日期在澳大利亚是无效的,没有第21个月,我可以很容易地用一个快速的=RIGHT(LEFT(B2,5),2)&"/"&LEFT(B2,2)&"/"&RIGHT(B2,10)解决这个问题,但我的问题来了,当我们到了日期,如09/12/2022年,因为有12月9日和9月12日,Excel非常友好地将其转换为日期整数,这打破了上述代码,因为左/右不再引用09/12/2022而是44904。
任何对我能做什么有建议的人都可以停止Excel“帮助”并将日期转换为美国的解释-我已经检查了机器并仔细检查了所有窗口设置是否为正确的日期格式。
最大的问题是,我需要将这些日期与我们从另一个数据集中提取的一些日期进行比较,这些数据集的“正确”格式为d/m/y,而不是只有美国人似乎坚持使用的m/d/y,因此需要将它们保留为日期和准确= \

jv2fixgn

jv2fixgn1#

如果**(US)Date的月份小于或等于12,则将日期转换为月份,而其他日期仍为字符串/文本**,请使用下一个函数:

Function convertUSStr_DateToAU(arr As Variant) As Variant
    Dim arrConv, arrStrD, i As Long
    ReDim arrConv(1 To UBound(arr), 1 To 1)
    For i = 1 To UBound(arrConv)
        If IsNumeric(arr(i, 1)) Then
            arrConv(i, 1) = DateSerial(Year(arr(i, 1)), Day(arr(i, 1)), Month(arr(i, 1)))
        Else
            arrStrD = Split(arr(i, 1), "/")
            arrConv(i, 1) = DateSerial(CLng(arrStrD(2)), CLng(arrStrD(0)), CLng(arrStrD(1)))
        End If
    Next i
    convertUSStr_DateToAU = arrConv
End Function

它可以用于以下方式:

Sub testConvertUSStr_DateToAU()
     Dim sh As Worksheet, lastR As Long, arrD
     Const Col As String = "B" 'column letter where the data to be correctly converted exists
     
     Set sh = ActiveSheet
     lastR = sh.Range(Col & sh.rows.count).End(xlUp).row
     
     arrD = sh.Range(Col & 2 & ":" & Col & lastR).Value2 'Date is taken as number...
     arrD = convertUSStr_DateToAU(arrD)
     'drop the converted array content and format it appropriately:
     With sh.cells(2, Col).Offset(, 1).Resize(UBound(arrD), 1)
            .Value2 = arrD
            .NumberFormat = "dd/mm/yyy"
     End With
End Sub

你必须在要转换/处理的列后面有一个空列。实际的代码返回该空列中的转换数组。但是,只是让你检查它是否返回了你需要的内容。
如果是这样的话,你应该修改With语句的范围,只删除.Offset(, 1)。这样,它将准确地返回需要转换Date的原始列。

相关问题