excel 在VBA导入时将d/m/y格式应用于US格式日期

jvlzgdj9  于 2023-03-31  发布在  其他
关注(0)|答案(1)|浏览(133)

我发现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忽略美国化的日期,直到我能做些什么来修复它们。)
有一些日期是以美国的方式格式化的-例如09/21/2022。这个特定的日期在澳大利亚是无关紧要的,它是无效的,没有第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将日期转换为美国的解释。我检查了所有的Windows设置都是正确的日期格式。
我需要将这些日期与从另一个数据集中提取的日期进行比较,这些数据集的“正确”格式是d/m/y,而不是m/d/y。

yws3nbqq

yws3nbqq1#

如果**(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的原始列。

相关问题