Преобразование текстовой даты в нормальную

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по Excel » Преобразование текстовой даты в нормальную (Формулы/Formulas)

anaumov

Дата: Понедельник, 08.04.2019, 14:45 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

Здравствуйте!
Задача преобразовать дату, импортированную из другой программы в виде текста в настоящую дату.
Нашел на этом форуме решение:

[vba]

Код

Sub DateENG()

en = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")

rus = Array("01", "02", "03", "04", "05", "06", "07", "08", "09", "10", "11", "12")

For Each cell In Selection
With cell
txt = Mid(.Value, 1, 3)
For x = 0 To UBound(en)
If en(x) = txt Then
.Replace What:=txt, Replacement:=rus(x), LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
.Value = CDate(.Value)
.NumberFormat = "dd.mm.yyyy"
Exit For
End If
Next x
End With
Next cell
End Sub

[/vba]
Правда потом потерял его. Доработал под себя немного. Работает.

Однако вот скрин:

Не могу понять, почему скрипт в одном случае интерпретирует дату правиль, а в другом путает местами число и месяц.
Что не так?

Помогите, пожалуйста. Заранее благодарен.

К сообщению приложен файл: 1956973.xlsx (9.1 Kb)

Сообщение отредактировал anaumov - Понедельник, 08.04.2019, 15:11

Ответить

_Boroda_

Дата: Понедельник, 08.04.2019, 14:47 | Сообщение № 2

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

- Прочитайте Правила форума
- Приложите файл с исходными данными и желаемым результатом (можно вручную) в формате Excel размером до 100кб согласно п.3 Правил форума
- Оформите код тегами (в режиме правки поста выделите код и нажмите кнопку #, пояснялка здесь)

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Ответить

bmv98rus

Дата: Понедельник, 08.04.2019, 15:06 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4107

Репутация: 768 ±

Замечаний: 0% ±

Excel 2013/2016

anaumov, и пока еще можно, в названии темы опечатку исправьте, Преоюразование глаз режет.

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Сообщение отредактировал bmv98rus - Понедельник, 08.04.2019, 15:06

Ответить

_Boroda_

Дата: Понедельник, 08.04.2019, 15:11 | Сообщение № 4

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

А где макрос, который "немного. Работает"? Приведенный в тексте поста не работает и работать не может с такими данными

Ответить

anaumov

Дата: Понедельник, 08.04.2019, 15:22 | Сообщение № 5

Группа: Пользователи

Ранг: Прохожий

Сообщений: 6

Репутация: 0 ±

Замечаний: 0% ±

Excel 2016

_Boroda_, там действительно работает макрос, который приведен выше, только с помощью имеемой у меня надстройки, я убрал (обрезал лишние символы в написании даты в тексте). Ну т.е. сначала привел вид колонки с датой в вид: Jan 1 2019, например.

Ответить

_Boroda_

Дата: Понедельник, 08.04.2019, 15:26 | Сообщение № 6

Группа: Модераторы

Ранг: Местный житель

Сообщений: 16675

Репутация: 6481 ±

Замечаний: 0% ±

2003; 2007; 2010; 2013 RUS

Мдя.
Держите
[vba]

Код

Sub DateENG()
    en = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")
    rus = Array("Янв", "Фев", "Мар", "Апр", "Май", "Июн", "Июл", "Авг", "Сен", "Окт", "Ноя", "Дек")
    Application.ScreenUpdating = 0
    For Each с_ In Selection
        With с_
            txt = Mid(.Value, 5, 6)
            For x = 0 To UBound(en)
                If en(x) = Left(txt, 3) Then
                    .Value = CDate(Replace(txt, en(x), rus(x)) & Right(c_, 4))
                    .NumberFormat = "dd.mm.yyyy"
                    Exit For
                End If
            Next x
        End With
    Next с_
    Application.ScreenUpdating = 1
End Sub

[/vba]