Замените «H» на «:» даты и часа без изменения формата даты vba - PullRequest
0 голосов
/ 19 октября 2018

У меня есть различные даты (тип строки) в формате дд / мм / гггг чччмм: дд / мм / гггг чччмм Мне нужно было преобразовать их в фактическую дату типа в формате дд / мм / ггггчч: мм: дд / мм / гггг чч: мм

Моя проблема заключалась в том, что когда я выполнял команду замены вручную, все работало нормально, но если я реализовал команду замены в макросе, он внезапно изменился с дд / мм / гг чччмм на мм / дд / гггг чч: мм, что означало, что все мои данные были неверными.

Я решил проблему с помощью для цикла и функции разделения , и собираюсь поставить решение здесь, так что, возможно, кто-то другой с такой же проблемой может получить его какспасибо за каждый раз, когда я получал помощь здесь:

lastRowRan = Cells(Rows.Count, "B").End(xlUp).Row 
For Each cell In Range("I2:I" & lastRowRan)
        dateArray = Split(cell)
        dateArray(1) = Replace(dateArray(1), "H", ":")
        cell.Value = CDate(Format(CDate(dateArray(0) & " " & dateArray(1)), "dd/mm/yyyy hh:mm")) 
Next

Но очевидно, поскольку таких дат тысячи, иногда это может занять некоторое время.Так что мне было интересно, есть ли более быстрый способ?

.NumberFormat, похоже, не работает.

Ответы [ 2 ]

0 голосов
/ 19 октября 2018

Используйте DateSerial(Year, Month, Day) и TimeSerial(Hour, Minute, Second) для построения реальной даты:

Dim lastRowRan As Long
lastRowRan = Cells(Rows.Count, "B").End(xlUp).Row

Dim Cell As Range
For Each Cell In Range("I2:I" & lastRowRan)
    If Not IsDate(Cell.Value) Then
        Cell.Value = DateSerial(Mid$(Cell.Value, 7, 4), Mid$(Cell.Value, 4, 2), Left$(Cell.Value, 2)) + TimeSerial(Mid$(Cell.Value, 12, 2), Right$(Cell.Value, 2), 0)
        Cell.NumberFormat = "dd/mm/yyyy hh:mm"
    End If
Next Cell
0 голосов
/ 19 октября 2018

Попробуйте:

Sub Test()

    Dim LastRow As Long
    Dim i As Long
    Dim ClearDate As Date

    LastRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row '<= Change to cover your range

    For i = 1 To LastRow '<= Set the right start & end point
        With Sheet1 '<=Cahnge to fit your sheet
            ClearDate = CDate(Replace(Range("A" & i), "H", ":"))
            .Range("A" & i).Offset(0, 1).Value = ClearDate
        End With
    Next i

End Sub

Результаты:

enter image description here

...