Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/изменение формата даты - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_, DrMini  
Мир MS Excel » Вопросы и решения » Вопросы по Excel » изменение формата даты (Формулы/Formulas)
изменение формата даты
doberman Дата: Четверг, 20.04.2017, 00:26 | Сообщение № 1
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Доброго времени суток! Помогите кто знает как из даты числового формата превратить дату число-буквенный формат. (есть 01.01.2017 г. нужно 1 января 2017 года). На одном листе много дат. Возможно-ли через макрос произвести замену формата дат на всем листе?
К сообщению приложен файл: 2047146.xlsx (9.7 Kb)
 
Ответить
СообщениеДоброго времени суток! Помогите кто знает как из даты числового формата превратить дату число-буквенный формат. (есть 01.01.2017 г. нужно 1 января 2017 года). На одном листе много дат. Возможно-ли через макрос произвести замену формата дат на всем листе?
Автор - doberman
Дата добавления - 20.04.2017 в 00:26
Perfect2You Дата: Четверг, 20.04.2017, 15:44 | Сообщение № 2
Группа: Проверенные
Ранг: Форумчанин
Сообщений: 237
Репутация: 59 ±
Замечаний: 0% ±

Excel 2010
Макрос обрабатывает выделенный диапазон. Рассчитан на выделение 1 области и не более одного столбца. Резулььтат помещает в соседний справа столбец.
[vba]
Код
Sub perebr()
Dim arrD As Variant, arrT As Variant
Dim I As Long, J As Long, R As Long
Dim D As Integer, M As Integer, Y As Integer

If Selection.Areas.Count > 1 Then Exit Sub
If Selection.Columns.Count > 1 Then Exit Sub

arrD = Selection.Value

If IsArray(arrD) Then
  For J = LBound(arrD) To UBound(arrD)
    arrT = Split(arrD(J, 1))
    If IsArray(arrT) Then
        For I = LBound(arrT) To UBound(arrT)
            If arrT(I) Like "##.##.####" Then
                D = Val(Left(arrT(I), 2))
                M = Val(Mid(arrT(I), 4, 2))
                Y = Val(Right(arrT(I), 4))
                If IsDate(arrT(I)) Then
                    arrT(I) = Format(D, "0") & " " & _
                            Application.Index(Array("января", "февраля", "марта", "апреля", "мая", "июня", "июля", "августа", _
                            "сентября", "октября", "ноября", "декабря"), M) & " " & Format(Y, "0000")
                    If I = UBound(arrT) Then
                        arrT(I) = arrT(I) & " г."
                    ElseIf Left(arrT(I + 1), 2) = "г." Then
                    ElseIf Left(arrT(I + 1), 4) = "года" Then
                        arrT(I + 1) = Replace(arrT(I + 1), "года", "г.", 1, 1)
                    Else
                        arrT(I) = arrT(I) & " г."
                    End If
                End If
            End If
        Next I
    End If
    arrD(J, 1) = Join(arrT)
  Next J
  R = UBound(arrD) - LBound(arrD) + 1
Else
    arrT = Split(arrD)
    If IsArray(arrT) Then
        For I = LBound(arrT) To UBound(arrT)
            If arrT(I) Like "##.##.####" Then
                D = Val(Left(arrT(I), 2))
                M = Val(Mid(arrT(I), 4, 2))
                Y = Val(Right(arrT(I), 4))
                If IsDate(arrT(I)) Then
                    arrT(I) = Format(D, "0") & " " & _
                            Application.Index(Array("января", "февраля", "марта", "апреля", "мая", "июня", "июля", "августа", _
                            "сентября", "октября", "ноября", "декабря"), M) & " " & Format(Y, "0000")
                End If
            End If
        Next I
    End If
    arrD = Join(arrT)
    R = 1
End If
Selection.Cells(1, 1).Offset(0, 1).Resize(R, 1).Value = arrD
End Sub
[/vba]
Работать должен шустро даже на больший объемах данных.
Если будет тормозить, оптимизировать вряд ли получится, если только добавить отслеживание строки состояния: сколько обработано, сколько осталось.

Чуть исправил. Файл перезалил.
К сообщению приложен файл: _2047146.xlsm (19.4 Kb)


Сообщение отредактировал Perfect2You - Четверг, 20.04.2017, 15:51
 
Ответить
СообщениеМакрос обрабатывает выделенный диапазон. Рассчитан на выделение 1 области и не более одного столбца. Резулььтат помещает в соседний справа столбец.
[vba]
Код
Sub perebr()
Dim arrD As Variant, arrT As Variant
Dim I As Long, J As Long, R As Long
Dim D As Integer, M As Integer, Y As Integer

If Selection.Areas.Count > 1 Then Exit Sub
If Selection.Columns.Count > 1 Then Exit Sub

arrD = Selection.Value

If IsArray(arrD) Then
  For J = LBound(arrD) To UBound(arrD)
    arrT = Split(arrD(J, 1))
    If IsArray(arrT) Then
        For I = LBound(arrT) To UBound(arrT)
            If arrT(I) Like "##.##.####" Then
                D = Val(Left(arrT(I), 2))
                M = Val(Mid(arrT(I), 4, 2))
                Y = Val(Right(arrT(I), 4))
                If IsDate(arrT(I)) Then
                    arrT(I) = Format(D, "0") & " " & _
                            Application.Index(Array("января", "февраля", "марта", "апреля", "мая", "июня", "июля", "августа", _
                            "сентября", "октября", "ноября", "декабря"), M) & " " & Format(Y, "0000")
                    If I = UBound(arrT) Then
                        arrT(I) = arrT(I) & " г."
                    ElseIf Left(arrT(I + 1), 2) = "г." Then
                    ElseIf Left(arrT(I + 1), 4) = "года" Then
                        arrT(I + 1) = Replace(arrT(I + 1), "года", "г.", 1, 1)
                    Else
                        arrT(I) = arrT(I) & " г."
                    End If
                End If
            End If
        Next I
    End If
    arrD(J, 1) = Join(arrT)
  Next J
  R = UBound(arrD) - LBound(arrD) + 1
Else
    arrT = Split(arrD)
    If IsArray(arrT) Then
        For I = LBound(arrT) To UBound(arrT)
            If arrT(I) Like "##.##.####" Then
                D = Val(Left(arrT(I), 2))
                M = Val(Mid(arrT(I), 4, 2))
                Y = Val(Right(arrT(I), 4))
                If IsDate(arrT(I)) Then
                    arrT(I) = Format(D, "0") & " " & _
                            Application.Index(Array("января", "февраля", "марта", "апреля", "мая", "июня", "июля", "августа", _
                            "сентября", "октября", "ноября", "декабря"), M) & " " & Format(Y, "0000")
                End If
            End If
        Next I
    End If
    arrD = Join(arrT)
    R = 1
End If
Selection.Cells(1, 1).Offset(0, 1).Resize(R, 1).Value = arrD
End Sub
[/vba]
Работать должен шустро даже на больший объемах данных.
Если будет тормозить, оптимизировать вряд ли получится, если только добавить отслеживание строки состояния: сколько обработано, сколько осталось.

Чуть исправил. Файл перезалил.
Автор - Perfect2You
Дата добавления - 20.04.2017 в 15:44
doberman Дата: Четверг, 06.07.2017, 22:58 | Сообщение № 3
Группа: Пользователи
Ранг: Новичок
Сообщений: 29
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
как запустить не пойму
 
Ответить
Сообщениекак запустить не пойму
Автор - doberman
Дата добавления - 06.07.2017 в 22:58
Pelena Дата: Пятница, 07.07.2017, 07:22 | Сообщение № 4
Группа: Админы
Ранг: Местный житель
Сообщений: 19509
Репутация: 4620 ±
Замечаний: ±

Excel 365 & Mac Excel
Такое решение "в лоб" не подойдёт?
Код
=ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A2;".01.";" января ");".02.";" февраля ");".03.";" марта ");".04.";" апреля ");".05.";" мая ");".06.";" июня ");".07.";" июля ");".08.";" августа ");".09.";" сентября ");".10.";" октября ");".11.";" ноября ");".12.";" декабря ")
К сообщению приложен файл: 5621467.xlsx (10.5 Kb)

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816
 
Ответить
СообщениеТакое решение "в лоб" не подойдёт?
Код
=ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(A2;".01.";" января ");".02.";" февраля ");".03.";" марта ");".04.";" апреля ");".05.";" мая ");".06.";" июня ");".07.";" июля ");".08.";" августа ");".09.";" сентября ");".10.";" октября ");".11.";" ноября ");".12.";" декабря ")
Автор - Pelena
Дата добавления - 07.07.2017 в 07:22
Мир MS Excel » Вопросы и решения » Вопросы по Excel » изменение формата даты (Формулы/Formulas)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2025 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!