时间戳

首页 > 解决方案 > 与日期格式相关的 VBA TextToColumns 错误

excel - 与日期格式相关的 VBA TextToColumns 错误

问题描述

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

背景：我有一个经常出现的相对较大的 *.csv 文件，其中包括三列日期/时间戳。这些当前是格式为“DD/MM/YYYY hh:mm”的文本。我的电脑默认是 D/M/Y。如果我在 Excel 中手动使用文本到列功能（分隔，未选择分隔符，列数据格式日期：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 中运行，但在 DMY 中运行 Excel。

有任何想法吗？谢谢

标签： excelvbadate-conversion

解决方案

处理此问题的“最佳”方法是正确导入 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

推荐阅读