Ошибки VBA TextToColumns, связанные с форматом даты

Question

У меня проблема с форматированием даты и TextToColumns. Несмотря на то, что я похож на некоторые другие темы, я не смог сопоставить их напрямую с моей проблемой.

Справочная информация: у меня есть повторяющийся относительно большой файл * .csv, который включает три столбца отметок даты / времени. В настоящее время это текст в виде «ДД / ММ / ГГГГ чч: мм». По умолчанию у меня компьютер D / M / Y. Если я вручную использую функцию «Текст в столбцы» в Excel (с разделителями, разделители не выбраны, формат данных столбцов Дата: DMY), тогда преобразование происходит правильно.

Ошибка: пытаясь автоматизировать преобразование в VBA, я записал макрос в качестве отправной точки, а затем пошел оттуда. Как только я закончил писать рутину, я запустил ее и увидел, что она сделала только половину дат. Дальнейшее расследование показало, что оно только изменило даты, которые могли быть в любом случае ... то есть день не превышал 12 числа. Затем я понял, что происходит то, что код работает только тогда, когда он может интерпретировать дату в формате MDY. Это означает, что на самом деле возникла ошибка, поскольку даты, такие как 05/02/2010 (5 февраля 2010 г.), затем появились как 02/05/2010 (2 мая 2010 г.).

Ключевая часть кода выглядит следующим образом:

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