Страницы: 1
RSS
Прописать Макрос по трансформации даты 27 грудня 2019 року на 27.12.2019, если даты, месяц и год разные по всему столбце
 
Есть таблица преобразованая из PDF в Excel, и выгрузились даты вид 28 вересня 2019 , как сделать так что бы весь столбец с датами которые разные , сделать вид 28.09.2019 , я пробовала по разному но получаеться долго. Можно ли прописать макрос и вывести одну формулу, я подозреваю что она будет довольно большой . Инфо во вложении  
 
Вариант на Power Query:
Код
let
    Source = Excel.CurrentWorkbook(){[Name="Таблица1"]}[Content],
    #"Changed Type with Locale" = Table.TransformColumnTypes(Source, {{"Дата встановлення ", type date}}, "uk-UA")
in
    #"Changed Type with Locale"
Вот горшок пустой, он предмет простой...
 
Код
=ЕСЛИОШИБКА(ДАТАЗНАЧ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ($F3;" січня ";".01.");" лютня ";".02.");" березня ";".03.");" квiтня ";".04.");" травня ";".05.");" червня ";".06.");" липня ";".07.");" серпня ";".08.");" вересня ";".09.");" жовтня ";".10.");" листопада ";".11.");" грудня ";".12."));F3)
 
Так тоже можно
Код
=ЕСЛИОШИБКА(ДАТАЗНАЧ(ПСТР(F3;1;2)&"-"&ПОИСК(ПСТР(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(F3;ПСТР(F3;1;2);""));1;3);"  січлютберквітрачерлипсервержовлисгру")/3&"-"&ПРАВСИМВ(СЖПРОБЕЛЫ(F3);4));F3)
 
В моем файле не сработал ни один пример, может быть дело в таблице самой, может проверить можно  
 
паразитирование на формуле Михаил Л,
Код
=ЕСЛИ(ЕЧИСЛО(--F3);F3;--(ЛЕВБ(F3;2)&"."&ПОИСК(ПСТР(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(F3;ПСТР(F3;1;2);""));1;3);"  січлютберквітрачерлипсервержовлисгру")/3&"."&ПРАВБ(СЖПРОБЕЛЫ(F3);4)))
Лень двигатель прогресса, доказано!!!
 
У меня в таблице ошибка  и все ни вкакую
#ЗНАЧ!
 
Цитата
Isobev написал:
У меня в таблице ошибка
значит пример который вы приложили не соответствует исходным данным какие у вас есть
Лень двигатель прогресса, доказано!!!
 
Isobev,
Как прописываются остальные недостающие месяцы: февраль(лютня), март(березня) и т.д.
В строке 14 написано 11січня 2019 - нет пропуска между датой и месяцем
 
Во вложении весь файлс датами  
Изменено: Isobev - 21.02.2020 12:44:36
 
запись исходника "28 травня 2019р." не тоже самое что в приложенном первом примере "28 травня 2019"  
Лень двигатель прогресса, доказано!!!
 
Я через Заменть убрала р. в столбце  
 
на последнем примере отработала полностью
Код
=ЕСЛИ(ЕЧИСЛО(--I6);I6;--(ЛЕВБ(I6;2)&"."&ПОИСК(ПСТР(СЖПРОБЕЛЫ(ПОДСТАВИТЬ(I6;ПСТР(I6;1;2);""));1;3);"  січлютберквітрачерлипсервержовлисгру")/3&"."&ПРАВБ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(ПОДСТАВИТЬ(I6;" ";"");"р";"");".";"");4)))
Лень двигатель прогресса, доказано!!!
 
Сергей спасибо. Я вообще срмоучка и новичок, Просмотрела курсы Павлова также Самоучитель https://www.specialist.ru/product/excel-courses .
Пытаюсь разбираться , может Вы еще подскажите дополнительно видео или методы изучения ЕКСКЛЬ , VBA. PQw  и т.д.  
 
изучите сайт планеты тут много чего есть
Лень двигатель прогресса, доказано!!!
 
Цитата
Isobev написал:
видео или методы изучения ЕКСКЛЬ , VBA. PQw  и т.д.  
Да тут весь сайт этому посвящен. Все уже освоили? Надо что-то еще?
Вот горшок пустой, он предмет простой...
 
Спасибо . Я сейчас буду пробовать записать макрос по данной формуле для применения ее в дальнейшем.  
 
Isobev,
В таблице удалите объединенные ячейки (типа строк 76, 143 и т.д.)
В столбце I макрос убрает р. и року
Результат в столбце J
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iDateMonth As String
 iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
 Range("J6:J" & iLastRow).ClearContents
 Range("I6:I" & iLastRow).Replace "р.", ""
 Range("I6:I" & iLastRow).Replace "року", ""
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "\s?[іа-я]+\s?"
  For i = 6 To iLastRow
   If Not IsDate(Cells(i, "I")) And Not IsEmpty(Cells(i, "I")) Then
     iDateMonth = .Execute(Cells(i, "I"))(0)
    Select Case iDateMonth
     Case " січня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".01.")
     Case " лютого ": Cells(i, "J") = .Replace(Cells(i, "I"), ".02.")
     Case " березня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".03.")
     Case " квітня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".04.")
     Case " травня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".05.")
     Case " червня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".06.")
     Case " липня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".07.")
     Case " серпня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".08.")
     Case " вересня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".09.")
     Case " жовтня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".10.")
     Case " листопада ": Cells(i, "J") = .Replace(Cells(i, "I"), ".11.")
     Case " грудня ": Cells(i, "J") = .Replace(Cells(i, "I"), ".12.")
    End Select
      Cells(i, "J").NumberFormat = "dd.mm.yyyy"
   Else
     Cells(i, "J") = Cells(i, "I")
     Cells(i, "J").NumberFormat = "dd.mm.yyyy"
   End If
  Next
 End With
End Sub

В ячейках типа 11січня 2019 надо вставить пробел 11 січня 2019
Изменено: Kuzmich - 21.02.2020 14:02:47
 
Добрый день! Я взяла вариант на Power Query, который предложил PooHkrd , там где ячейки объединенные, просто вручную пересматриваю, я так поняла по другому не получиться , так как весь файл практически имеет объединенные ячейки.  
 
Цитата
там где ячейки объединенные, просто вручную пересматриваю, я так поняла по другому не получиться
Строки типа 76, 143 и т.д ( с объединенными ячейками) можно удалить макросом. Попробуйте удалить такие строки
вручную, а затем уже запустить макрос.
 
Я нашла макрос для разъединения объединенных ячеек таблицы

Sub RazdelitVstavit()
Dim adres As String
Dim i As Long
For i = 1 To Selection.Count
 adres = Selection(i).MergeArea.Address
 If adres <> Selection(i).Address Then
   Selection(i).UnMerge
   Selection(i).Copy
   ActiveSheet.Paste ActiveSheet.Range(adres)
   Application.CutCopyMode = False
 End If
Next
End Sub
 
Потом применяю макрос, что порекомедавал
Kuzmich
Но полезла проблема №2 Пример :
дата 1 січня 2019 становиться 1.01.2019. и все цифры от 1 до 9 не содержат цифру 0 в нанчале для получения формата даты 01.01.2019 года. Если поможете ОГРОМНОЕ СПАСИБО.  
 
Isobev,
Цитата
Но полезла проблема №2
формат ячейки Дата, Тип *14.03.2001
Код
Sub Tablica()
Dim i As Long
Dim iLastRow As Long
Dim iDateMonth As String
   iLastRow = Cells(Rows.Count, "I").End(xlUp).Row
   Range("J6:J" & iLastRow).ClearContents
   Range("I6:I" & iLastRow).Replace "р.", ""
   Range("I6:I" & iLastRow).Replace " р", ""
   Range("I6:I" & iLastRow).Replace ".", ""
   Range("I6:I" & iLastRow).Replace "року", ""
 With CreateObject("VBScript.RegExp")
     .Global = True
     .IgnoreCase = True
     .Pattern = "[іа-я]+"
  For i = 6 To iLastRow
   If Not IsDate(Cells(i, "I")) And Not IsEmpty(Cells(i, "I")) Then
     iDateMonth = .Execute(Cells(i, "I"))(0)
    Select Case iDateMonth
     Case "січня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " января "))
     Case "лютого": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " февраля "))
     Case "березня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " марта "))
     Case "квітня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " апреля "))
     Case "травня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " мая "))
     Case "червня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " июня "))
     Case "липня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " июля "))
     Case "серпня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " августа "))
     Case "вересня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " сентября "))
     Case "жовтня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " октября "))
     Case "листопада": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " ноября "))
     Case "грудня": Cells(i, "J") = CDate(.Replace(Cells(i, "I"), " декабря "))
    End Select
   Else
     If Not IsEmpty(Cells(i, "I")) Then
       Cells(i, "J") = CDate(Cells(i, "I"))
     End If
   End If
  Next
 End With
End Sub
Изменено: Kuzmich - 26.02.2020 11:56:58
Страницы: 1
Наверх