Форматирование дат и региональные настройки Excel VBA

Question

Это супер расстраивает и не имеет смысла для меня.

Это в Excel 2010.

Я записал макрос для форматирования некоторых данных, содержащих дату (ДД / ММ / ГГГГ). Я импортирую это, Excel видит это как текст. Поэтому я использую записанный мной макрос "text to date", сохраняю его в VBA sub.

Вот записанный макрос:

Sub DateFormatting()
    Sheets("Donnees").Select
    Columns("H:H").Select
    Selection.TextToColumns Destination:=Range("H1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, OtherChar _
        :="/", FieldInfo:=Array(1, 4), TrailingMinusNumbers:=True
End Sub

Когда я импортирую свои данные, сначала у меня есть это. Вы можете видеть, что Excel воспринимает его как TEXT, потому что он выровнен по левому краю (столбец H, и я подтверждаю, что это действительно так):

Затем я запускаю макрос и получаю это (столбец H):

Вы можете видеть, что Excel видит его как дату, так как он выровнен по правому краю. Если я преобразую его в "число", я вижу основной серийный номер, как и ожидалось. Так что можно подумать, что все в порядке. Но это действительно не так:

Если я запустил макрос ОПЯТЬ (и сделал бы это, потому что позже к нему будет добавлено больше данных, поэтому я должен убедиться, что вновь импортированные данные в нижней части также будут правильно отформатированы), я получу это:

Таким образом, в основном он изменил формат с ДД / ММ / ГГГГ (который, как предполагается, должен быть) на ММ / ДД / ГГГГ (что неверно). Если я снова запускаю этот макрос для этого набора данных, он переключается обратно на ДД / ММ / ГГГГ.

Но самое худшее в том, что если я ВРУЧНУЮ точно так же делаю (например, вместо запуска макроса, я вручную перехожу к "Данные", "Текст в столбцы" и выбираю ТОЧНЫЕ опции), то это не меняется. Если дата отформатирована как ДД / ММ / ГГГГ, она остается такой же, а если она отформатирована как ММ / ДД / ГГГГ (из-за этой глупой причуды), то она остается такой же. Я повторяю это достаточно (и даже перезаписываю макрос пару раз), чтобы УВЕРЕН, что делаю точно такие же вещи.

Я знаю, что это из-за региональных настроек, но файл не всегда будет использоваться на моем компьютере, и я не могу гарантировать, что у конечного пользователя будут какие-то конкретные региональные настройки. Мне нужно, чтобы этот файл не зависел от настроек региона.

МОЙ ВОПРОС: Как я могу убедиться, что эти даты:

• Отформатирован и распознан как дата в Excel
• Независимо от локальных региональных настроек пользователей?

Я знаю, что могу либо перейти к промежуточному этапу импорта (и отформатировать данные там, а не в основном файле), либо затем настроить код так, чтобы макрос применялся только к новым импортированным данным... Но тогда я чувствую, что это не так надежный, потому что, как я знаю, Excel не испортит формат?

О, потому что макрос немного загадочно смотрит на VBA:

Я перехожу в Data, Text to Column, выбираю "Delimited" (не имеет значения, потому что я фактически не делю его на столбцы), затем "Delimiters" по умолчанию (опять же, не имеет значения, я фактически не разделяю текст в столбцы), затем "Дата" и в выпадающем списке "DYM" для ДД / ММ / ГГГГ

РЕДАКТИРОВАТЬ: Пожалуйста, смотрите ответ Рона Розенфилда для более подробной информации. Для полноты вот код, который я буду запускать, чтобы импортировать данные и отформатировать их при импорте, а не импортировать их и затем отформатировать:

Sub importData()
Dim myFile As String
myFile = Sheet5.Cells(2, 5).Value 'My metadata sheet, containing name of file to import

Sheet1.Select  'Setting target sheet as active worksheet
    With ActiveSheet.QueryTables.Add(Connection:="TEXT;C:\ChadTest\" & myFile, _
    Destination:=Sheet1.Cells(Sheet5.Cells(2, 1).Value, 1))
        .Name = "ExternalData_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 1252
If Sheet1.Cells(1, 1).Value = "" Then
  .TextFileStartRow = 1
Else
  .TextFileStartRow = 2
End If
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 4, 1, 1, 1, 4, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Sheet1.Select
    Application.WindowState = xlMinimized
    Application.WindowState = xlNormal
End Sub

Answer 1

Из того, что вы пишете, кажется, что вы получаете данные из файла TEXT или CSV, который вы открываете в Excel, а затем пытаетесь обработать дату. Обычная проблема.

Вместо этого вы можете ИМПОРТИРОВАТЬ файл. Если вы это сделаете, мастер импорта текста (так же, как мастер преобразования текста в столбцы) откроется ДО того, как данные будут записаны на лист, и даст вам возможность указать формат импортируемых дат.

Эта опция должна быть на вкладке Получить внешние данные ленты данных:

Я немного озадачен тем процессом, который вы используете для передачи данных из источника на лист Excel, но весь процесс, безусловно, можно автоматизировать с помощью VBA. И не должно быть необходимости запускать макрос на уже импортированных данных.

Answer 2

если вы открываете текстовый файл (например, csv), используйте vba, чтобы заставить его открываться с использованием локального форматирования даты Workbooks.Open Filename:=strPath & strFile, Local:=True

избегает всех обходных путей

Answer 3

На самом деле у нас была эта проблема довольно много на работе. мы выяснили, что лучший способ обойти эту проблему - убедиться, что даты в базовых данных имеют формат "ГГГГ / ММ / ДД", таким образом, они распознаются как одна и та же дата в американском или обычном формате даты, и это будет на самом деле правильно следовать вашим региональным настройкам, чтобы поставить правильную дату в Excel...

Answer 4

Это то, что я придумал, используя то, что я упомянул в моем комментарии выше:

Sub DateFormatting()

    On Error Resume Next

    Application.ScreenUpdating = False

    Dim wbCurrent As Workbook
    Dim wsCurrent As Worksheet
    Dim nLastRow, i, nDay, nMonth, nYear As Integer
    Dim lNewDate As Long

    Set wbCurrent = ActiveWorkbook
    Set wsCurrent = wbCurrent.ActiveSheet
    nLastRow = wsCurrent.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    For i = nLastRow To 2 Step -1
        If InStr(1, wsCurrent.Cells(i, 8), "/", vbBinaryCompare) > 0 Then
            nYear = Right(wsCurrent.Cells(i, 8), 4)
            nMonth = Mid(wsCurrent.Cells(i, 8), InStr(1, wsCurrent.Cells(i, 8), "/", vbBinaryCompare) + 1, 2)
            nDay = Left(wsCurrent.Cells(i, 8), 2)
            lNewDate = CLng(DateSerial(nYear, nMonth, nDay))
            wsCurrent.Cells(i, 8).Value = lNewDate
        End If
    Next i

    wsCurrent.Range("H:H").NumberFormat = "dd/mm/yyyy"

    Application.ScreenUpdating = True

End Sub

В этом коде предполагается, что исходные необработанные данные всегда будут импортироваться в виде текста в формате дд / мм / гггг, включая ведущие нули.

Он не будет касаться каких-либо реальных дат (т. Е. Когда фактическое значение ячейки является последовательным), кроме как для форматирования их.

Answer 5

Здесь я буду предполагать, что ваши даты всегда будут записаны в формате dd/mm/yyyy,

Если бы у меня была только одна клетка для проверки, я бы сделал это:

Dim s() As String
With Range("A1")
    If .NumberFormat = "@" Then
        'It's formatted as text.
        .NumberFormat = "dd/mm/yyyy"
        s = Split(.Value, "/")
        .Value = DateSerial(CInt(s(2)), CInt(s(1)), CInt(s(0)))
    Else
        'It isn't formatted as text. Do nothing.
    End If
End With

Однако, это плохо масштабируется, если у вас есть много ячеек для проверки; цикл через клетки идет медленно. Проходить через массив гораздо быстрее, например так:

Dim r As Range
Dim v As Variant
Dim i As Long
Dim s() As String
Set r = Range("H:H").Resize(GetLastNonblankRowNumber(Range("H:H"))) 'or wherever 
v = r.Value ' read all values into an array (could be strings, could be real dates)
For i = 1 To UBound(v, 1)
    If VarType(v(i, 1)) = vbString Then
        s = Split(v(i, 1), "/")
        v(i, 1) = DateSerial(CInt(s(2)), CInt(s(1)), CInt(s(0)))
    End If
Next i
With r
    .NumberFormat = "dd/mm/yyyy"
    .Value = v 'write dates back to sheet
End With

где я использую:

Function GetLastNonblankRowNumber(r As Range) As Long
    GetLastNonblankRowNumber = r.Find("*", r.Cells(1, 1), xlFormulas, xlPart, _
       xlByRows, xlPrevious).Row
End Function