Question

我在日期格式和TextToColumns方面遇到问题。尽管与其他一些线程相似，但我无法将它们直接与我的问题匹配。

背景：我有一个经常出现的相对较大的* .csv文件，其中包含三列日期/时间戳。这些当前为文本，格式为“ DD / MM / YYYY hh：mm”。默认情况下，我的计算机是D / M / Y。如果我在Excel中手动使用“文本到列”功能（带分隔符，未选择任何分隔符，列数据格式为Date：DMY），则转换将正确进行。

错误：在尝试自动在VBA中进行转换时，我记录了一个宏作为起点，然后从那里开始。一旦完成例程编写，就运行它，发现它只执行了大约一半的日期。进一步的调查显示，它只更改了日期的一种方式，即日期不超过12日。然后我意识到发生的事情是，代码仅在可以以MDY格式解释日期时才“起作用”。这意味着它实际上创建了一个错误，例如日期为05/02/2010（2010年2月5日），然后显示为02/05/2010（2010年5月2日）。

代码的关键部分如下：

Range("SCDB").Columns(aryColTitleIndex(i)).TextToColumns _
  Destination:=Range("SCDB").Columns(aryColTitleIndex(i)), _
  DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
  ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
  Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, xlDMYFormat), _
  TrailingMinusNumbers:=True

（命名范围和列索引正常工作）。我尝试了FieldInfo：= Array（1，4）以及上面显示的内容，但是没有任何变化。基本上，VBA似乎要在MYD中运行，而Excel在DMY中运行。

有什么想法吗？谢谢

Answer 1

处理此问题的“最佳”方法是正确导入CSV文件。如果这样做，您可以在导入时指定日期格式，然后Excel将日期转换为文本字符串和不正确转换的日期的组合。

如果这是不可能的，并且必须与错误地导入原始数据的xls文件完全兼容，则可以尝试使用此宏。它应该可以工作，但是请仔细阅读说明以获取可能的陷阱和使用信息。

Option Explicit
Sub ConvertDates()
    'converts dates that have been mismatched MDY / DMY
    'Assumes dates are all in selected column
    '   Only need to select a single cell in the column
    '   will place results in a column next to original data
    ' If adjacent column is not blank, a column will be inserted
    'Figures out the original format by analyzing a "text" date
    'Time components are converted directly.  This might be OK unless
    ' in a non standard format such as 1400Z

Dim R As Range, C As Range
Dim sDelim As String
Dim FileDateFormat As String * 3
Dim I As Long, J As Long, V As Variant
Dim vDateParts As Variant
Dim YR As Long, MN As Long, DY As Long
Dim TM As Double
Dim vRes As Variant 'to hold the results of conversion

Set R = Selection

'Test that selected cell contains a date
If Not IsDate(R(1)) Then
    MsgBox "Select a cell containing a date"
    Exit Sub
End If

Set R = Intersect(R.EntireColumn, ActiveSheet.UsedRange)
ReDim vRes(1 To R.Rows.Count, 1 To 1)

'Find a "text date" cell to analyze
For Each C In R
    With C
    If IsDate(.Value) And Not IsNumeric(.Value2) Then
        'find delimiter
        For I = 1 To Len(.Text)
            If Not Mid(.Text, I, 1) Like "#" Then
                sDelim = Mid(.Text, I, 1)
                Exit For
            End If
        Next I

        'split off any times
        V = Split(.Text & " 00:00")
        vDateParts = Split(V(0), sDelim)

        If vDateParts(0) > 12 Then
            FileDateFormat = "DMY"
            Exit For
        ElseIf vDateParts(1) > 12 Then
            FileDateFormat = "MDY"
            Exit For
        Else
            MsgBox "cannot analyze data"
            Exit Sub
        End If
    End If
    End With
Next C

If sDelim = "" Then
   MsgBox "cannot find problem"
   Exit Sub
End If

'Check that analyzed date format different from Windows Regional Settings
Select Case Application.International(xlDateOrder)
    Case 0 'MDY
        If FileDateFormat = "MDY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
    Case 1 'DMY
        If FileDateFormat = "DMY" Then
            MsgBox "File Date Format and Windows Regional Settings match" & vbLf _
                & "Look for problem elsewhere"
            Exit Sub
        End If
End Select

'Process dates
'Could shorten this segment but probably more understandable this way
J = 0
Select Case FileDateFormat
    Case "DMY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(1)
                DY = vDateParts(0)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            J = J + 1
            If YR = 0 Then
                vRes(J, 1) = C.Value
            Else
                vRes(J, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
    Case "MDY"
        For Each C In R
        With C
            If IsDate(.Value) And IsNumeric(.Value2) Then
            'Reverse the day and the month
                YR = Year(.Value2)
                MN = Day(.Value2)
                DY = Month(.Value2)
                TM = .Value2 - Int(.Value2)
            ElseIf IsDate(.Value) And Not IsNumeric(.Value2) Then
                V = Split(.Text & " 00:00") 'remove the time
                vDateParts = Split(V(0), sDelim)
                YR = vDateParts(2)
                MN = vDateParts(0)
                DY = vDateParts(1)
                TM = TimeValue(V(1))
            Else
                YR = 0
            End If

            J = J + 1
            If YR = 0 Then
                vRes(J, 1) = C.Value
            Else
                vRes(J, 1) = DateSerial(YR, MN, DY) + TM
            End If
        End With
        Next C
End Select

With R.Offset(0, 1).EntireColumn
    Set C = .Find(what:="*", LookIn:=xlFormulas)
    If Not C Is Nothing Then .EntireColumn.Insert
End With

R.Offset(0, 1).Value = vRes

End Sub

与日期格式有关的VBA TextToColumns错误

1 个答案: