Note: The other languages of the website are Google-translated. Back to English

Как быстро преобразовать дату в слова в Excel?

Как правило, мы обычно конвертируем дату в другие форматы даты или цифры в Excel, но сталкивались ли вы когда-нибудь с проблемой преобразования даты в английские слова, как показано на скриншоте ниже? На самом деле нет встроенной функции, которая могла бы с этим справиться, кроме кода VBA.
дата документа до слов 1

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


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

Вот код макроса, который может оказать вам услугу при преобразовании дат в слова.

1. Включите используемый лист и нажмите Alt + F11 ключи для открытия Microsoft Visual Basic для приложений окно.

2. Нажмите Вставить > Модули и вставьте ниже код в скрипт.

VBA: преобразовать дату в слово

Function DateToWords(ByVal xRgVal As Date) As String
'UpdatebyExtendoffice20170926
    Dim xYear As String
    Dim Hundreds As String
    Dim Decades As String
    Dim xTensArr As Variant
    Dim xOrdArr As Variant
    Dim xCardArr As Variant
    xOrdArr = Array("First", "Second", "Third", _
                   "Fourth", "Fifth", "Sixth", _
                   "Seventh", "Eighth", "Nineth", _
                   "Tenth", "Eleventh", "Twelfth", _
                   "Thirteenth", "Fourteenth", _
                   "Fifteenth", "Sixteenth", _
                   "Seventeenth", "Eighteenth", _
                   "Nineteenth", "Twentieth", _
                   "Twenty-first", "Twenty-second", _
                   "Twenty-third", "Twenty-fourth", _
                   "Twenty-fifth", "Twenty-sixth", _
                   "Twenty-seventh", "Twenty-eighth", _
                   "Twenty-nineth", "Thirtieth", _
                   "Thirty-first")
    xCardArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen")
    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")
    xYear = CStr(Year(xRgVal))
    Decades = Mid$(xYear, 3)
    If CInt(Decades) < 20 Then
        Decades = xCardArr(CInt(Decades))
    Else
        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
                xCardArr(CInt(Right$(Decades, 1)))
    End If
        Hundreds = Mid$(xYear, 2, 1)
    If CInt(Hundreds) Then
        Hundreds = xCardArr(CInt(Hundreds)) & " Hundred "
    Else
        Hundreds = ""
    End If
    DateToWords = xOrdArr(Day(xRgVal) - 1) & _
                  Format$(xRgVal, " mmmm ") & _
                  xCardArr(CInt(Left$(xYear, 1))) & _
                  " Thousand " & Hundreds & Decades
End Function

дата документа до слов 2

3. Сохраните код и вернитесь к листу, выберите ячейку, в которой вы будете выводить результат, введите эту формулу. = DateToWords (A1) (A1 - используемая вами дата), нажмите Enter и перетащите маркер автозаполнения на нужные ячейки. Смотрите скриншот:
дата документа до слов 3


Числа в слова

док разобрать номер 1

Относительные статьи:


Лучшие инструменты для работы в офисе

Kutools for Excel решает большинство ваших проблем и увеличивает вашу производительность на 80%

  • Снова использовать: Быстро вставить сложные формулы, диаграммы и все, что вы использовали раньше; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы без потери данных; Разделить содержимое ячеек; Объединить повторяющиеся строки / столбцы... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Более 300 мощных функций. Поддерживает Office/Excel 2007-2021 и 365. Поддерживает все языки. Простое развертывание на вашем предприятии или в организации. Полнофункциональная 30-дневная бесплатная пробная версия. 60-дневная гарантия возврата денег.
вкладка kte 201905

Вкладка Office: интерфейс с вкладками в Office и упрощение работы

  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно
Сортировать комментарии по
Комментарии (23)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Формула datetowords не работает во всех файлах exall
Этот комментарий был сведен к минимуму модератором на сайте
Извините, не могли бы вы сказать мне, какие типы файлов Excel не работают?
Этот комментарий был сведен к минимуму модератором на сайте
Это ставит дефис после десятилетий более 20, которые заканчиваются нулем.
Этот комментарий был сведен к минимуму модератором на сайте
Исправлен дефис после 20, 30, 40 и т.д.

Добавьте это после «Если CInt(Decades) < 20 Then
Десятилетия = xCardArr(CInt(Десятилетия))"

ElseIf CInt(Decades) Как "*0" Тогда
Десятилетия = xTensArr(CInt(Left$(Decades, 1)) - 2)
Этот комментарий был сведен к минимуму модератором на сайте
Ну, это работает, хорошо, но есть некоторые проблемы с форматом, так как 1975 (девятнадцать тысяч семьдесят пять) не (тысяча девятьсот семьдесят пять), но в случае 20+ формат правильный, как 2011 (две тысячи одиннадцать). ), а также вторая задача (единственное/множественное число), здесь (одна тысяча, две тысячи, одна сотня, девять сотен), пожалуйста, решите это, спасибо
Этот комментарий был сведен к минимуму модератором на сайте
Отлично ...
Этот комментарий был сведен к минимуму модератором на сайте
работа хорошая, но я хочу для 90-х "XNUMX", а не "XNUMX"... спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Извините, зиа хан, я не понимаю, что вы имеете в виду, когда переводите 90 в тысячу девятьсот. VBA может только конвертировать дату в слова, утилита Split Out Number конвертирует числа в слова английской валюты.
Этот комментарий был сведен к минимуму модератором на сайте
"Nineteen Hundred" говорят по-английски, на самом деле это неправильно.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, мы можем также сделать это в Word docx?
Этот комментарий был сведен к минимуму модератором на сайте
Дата слова на языке гуджарати доступна? пожалуйста, ответь мне. 9427909038
Этот комментарий был сведен к минимуму модератором на сайте
Я думаю, что это не работает для других языков, кроме английского.
Этот комментарий был сведен к минимуму модератором на сайте
как использовать этот код в vb6 для текстового поля
Этот комментарий был сведен к минимуму модератором на сайте
Sir / Madam

Это очень полезно для меня.

Действительно удивительно и помогло решить проблему в течение минуты.

Спасибо за загрузку этого документа. Очень хорошо
Этот комментарий был сведен к минимуму модератором на сайте
спасибо за помощь мне. очень полезно при преобразовании даты рождения в слове
Этот комментарий был сведен к минимуму модератором на сайте
Я хотел бы добавить текст к выводу, например, 1958 преобразуется в одну тысячу девятнадцать сотен пятьдесят восемь, и я хотел бы, чтобы он сказал одну тысячу девятнадцать сотен и Пятьдесят восемь. Может кто-нибудь дать мне пример того, как я могу это сделать, пожалуйста?
Этот комментарий был сведен к минимуму модератором на сайте
Это дает #ИМЯ? Ошибка
Этот комментарий был сведен к минимуму модератором на сайте
آپ کا بہت شکریہ
Этот комментарий был сведен к минимуму модератором на сайте
07 СЕДЬМОЕ АВГУСТА ТЫСЯЧА ДЕВЯТНАДЦАТАЯ СТО ДЕВЯНОСТО ВОСЬМОГО ГОДА
Мне нужно преобразовать слова в верхний формат, но я использую эти микрофайлы в Excel. Я получил это.
07 СЕДЬМОЕ АВГУСТА ТЫСЯЧА ДЕВЯТЬСОТ ДЕВЯНОСТО ВОСЬМОГО АВГУСТА
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Макс, я изменил VBA, пожалуйста, попробуйте и дайте мне знать, если он работает. Спасибо.
Function DateToWords(ByVal xRgVal As Date) As String
'UpdatebyExtendoffice20170926
    Dim xYear As String
    Dim Decades As String
    Dim years As String
    Dim xTensArr As Variant
    Dim xyearArr As Variant
    Dim xOrdArr As Variant
    Dim xCardArr As Variant
    xOrdArr = Array("First", "Second", "Third", _
                   "Fourth", "Fifth", "Sixth", _
                   "Seventh", "Eighth", "Nineth", _
                   "Tenth", "Eleventh", "Twelfth", _
                   "Thirteenth", "Fourteenth", _
                   "Fifteenth", "Sixteenth", _
                   "Seventeenth", "Eighteenth", _
                   "Nineteenth", "Twentieth", _
                   "Twenty-first", "Twenty-second", _
                   "Twenty-third", "Twenty-fourth", _
                   "Twenty-fifth", "Twenty-sixth", _
                   "Twenty-seventh", "Twenty-eighth", _
                   "Twenty-nineth", "Thirtieth", _
                   "Thirty-first")
    xCardArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen")
    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")
    xYear = CStr(Year(xRgVal))
    
    
      xyearArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen", "Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")

    years = xyearArr(CInt(Year(xRgVal) / 100)) & " Hundred"
    
    Decades = Mid$(xYear, 3)
    If CInt(Decades) < 20 Then
        Decades = xCardArr(CInt(Decades))
    Else
        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
                xCardArr(CInt(Right$(Decades, 1)))
    End If

    DateToWords = UCase(xOrdArr(Day(xRgVal) - 1) & _
                  Format$(xRgVal, " mmmm ") & _
                  years & " " & Decades)
End Function

Этот комментарий был сведен к минимуму модератором на сайте
07 СЕДЬМОЕ АВГУСТА ДВАДЦАТЬСОТ ДЕВЯНОСТО ВОСЬМОГО ГОДА
В этом vba есть ошибка
преобразовать его 1998, но он показывает ДВАДЦАТЬСОТ ДЕВЯНОСТО ВОСЕМЬ
Этот комментарий был сведен к минимуму модератором на сайте
Привет, попробуй этот vba:
Function DateToWords(ByVal xRgVal As Date) As String
'UpdatebyExtendoffice20170926
    Dim xYear As String
    Dim Decades As String
    Dim years As String
    Dim xTensArr As Variant
    Dim xyearArr As Variant
    Dim xOrdArr As Variant
    Dim xCardArr As Variant
    xOrdArr = Array("First", "Second", "Third", _
                   "Fourth", "Fifth", "Sixth", _
                   "Seventh", "Eighth", "Nineth", _
                   "Tenth", "Eleventh", "Twelfth", _
                   "Thirteenth", "Fourteenth", _
                   "Fifteenth", "Sixteenth", _
                   "Seventeenth", "Eighteenth", _
                   "Nineteenth", "Twentieth", _
                   "Twenty-first", "Twenty-second", _
                   "Twenty-third", "Twenty-fourth", _
                   "Twenty-fifth", "Twenty-sixth", _
                   "Twenty-seventh", "Twenty-eighth", _
                   "Twenty-nineth", "Thirtieth", _
                   "Thirty-first")
    xCardArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen")
    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")
    xYear = CStr(Year(xRgVal))
    
    
      xyearArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen", "Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")

    years = xyearArr(Fix(Year(xRgVal) / 100)) & " Hundred"
    
    Decades = Mid$(xYear, 3)
    If CInt(Decades) < 20 Then
        Decades = xCardArr(CInt(Decades))
    Else
        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
                xCardArr(CInt(Right$(Decades, 1)))
    End If

    DateToWords = UCase(xOrdArr(Day(xRgVal) - 1) & _
                  Format$(xRgVal, " mmmm ") & _
                  years & " " & Decades)
End Function

Этот комментарий был сведен к минимуму модератором на сайте
07 СЕДЬМОЕ АВГУСТА ДВАДЦАТЬСОТ ДЕВЯНОСТО ВОСЬМОГО ГОДА
В этом vba есть ошибка
преобразовать его 1998, но он показывает ДВАДЦАТЬСОТ ДЕВЯНОСТО ВОСЕМЬ
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL