Сумма прописью and excel and vba

Сумма прописью

Ниже вы найдете готовую пользовательскую функцию на VBA, которая переводит любое число от 0 до 9 999 999 в его текстовое представление, т.е. в сумму прописью. Перед использованием, эту функцию необходимо добавить в вашу книгу. Для этого:

1. нажмите сочетание клавиш ALT+F11, чтобы открыть редактор Visual Basic
2. добавьте новый пустой модуль через меню Insert — Module
3. скопируйте и вставьте туда текст этой функции:

Function СУММАПРОПИСЬЮ(n As Double) As String

 Dim Nums1, Nums2, Nums3, Nums4 As Variant

 Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", _
                        "восемьдесят ", "девяносто ")
 Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", _
                        "восемьсот ", "девятьсот ")
 Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", _
                        "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")

 If n <= 0 Then
   СУММАПРОПИСЬЮ = "ноль"
   Exit Function
 End If
 'разделяем число на разряды, используя вспомогательную функцию Class
 ed = Class(n, 1)
 dec = Class(n, 2)
 sot = Class(n, 3)
 tys = Class(n, 4)
 dectys = Class(n, 5)
 sottys = Class(n, 6)
 mil = Class(n, 7)
 decmil = Class(n, 8)

 'проверяем миллионы
 Select Case decmil
   Case 1
     mil_txt = Nums5(mil) & "миллионов "
     GoTo www
   Case 2 To 9
     decmil_txt = Nums2(decmil)
 End Select
 Select Case mil
   Case 1
     mil_txt = Nums1(mil) & "миллион "
   Case 2, 3, 4
     mil_txt = Nums1(mil) & "миллиона "
   Case  5 To 20
     mil_txt = Nums1(mil) & "миллионов "
 End Select
 www:
 sottys_txt = Nums3(sottys)
 'проверяем тысячи
 Select Case dectys
   Case 1
     tys_txt = Nums5(tys) & "тысяч "
     GoTo eee
   Case 2 To 9
     dectys_txt = Nums2(dectys)
 End Select
 Select Case tys
   Case 0
     If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч "
   Case 1
     tys_txt = Nums4(tys) & "тысяча "
   Case 2, 3, 4
     tys_txt = Nums4(tys) & "тысячи "
   Case 5 To 9
     tys_txt = Nums4(tys) & "тысяч "
 End Select
 If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч "
 eee:
 sot_txt = Nums3(sot)
 'проверяем десятки
 Select Case dec
   Case 1
     ed_txt = Nums5(ed)
     GoTo rrr
   Case 2 To 9
     dec_txt = Nums2(dec)
 End Select

 ed_txt = Nums1(ed)
 rrr:
 'формируем итоговую строку
 СУММАПРОПИСЬЮ = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
End Function

'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, I)
  Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))
End Function

Сохраните файл (если у вас Excel 2007 или 2010, то тип файла должен быть с поддержкой макросов, т.е. в формате xlsm!) и вернитесь в Excel. Теперь вы можете вставить созданную функцию в любую ячейку листа этой книги обычным способом — через мастер функций (кнопка f_x в строке формул, категория Определенные пользователем) или просто набрав ее в ячейке вручную и указав в качестве аргумента ячейку с суммой:

Если вам необходимо добавить к полученному тексту копейки, то можно воспользоваться чуть более сложной конструкцией:

 =СУММАПРОПИСЬЮ(A3)&» руб. «&ТЕКСТ((A3-ЦЕЛОЕ(A3))*100;»00″)&» коп.» 

=СУММАПРОПИСЬЮ(A3)&» руб. «&TEXT((A3-INT(A3))*100;»00″)&» коп.»

Тогда, например, для числа 35,15 результат функции будет выглядеть как «тридцать пять руб. 15 коп.»

Ссылки по теме

• Более мощный вариант функции с рублями и копейками на русском/английском из надстройки PLEX
• Что такое макросы, куда вставлять код макроса, как их использовать

Просмотров: 141

Постановка задачи. 

В работе часто встречается ситуация, когда необходимо вывести числовые значения в виде текста. Например, написать не «150», а «сто пятьдесят». В основном с такой задачей сталкиваются те, кто имеет дело с различными платежными бланками и банковскими ведомостями. Сумма прописью в таких документах должна быть обязательно указана.

Заинтересовавшись этой проблемой, я решил не изобретать велосипед и посмотреть решения данной проблемы в интернете. Скажу сразу, поиск был долгим. Решения были либо чересчур громоздкими, либо в виде нескольких процедур и функций. Меня это не удовлетворяло. В других случаях  код и его описание было очень невразумительным.

В результате поисков решение все-таки было найдено. Честно скажу,  не запомнил сайт-источник.  В этом я искренне каюсь и прошу прощения у автора. Также прошу прощения, что внес небольшие исправления. Итак, используем возможности VBA.

Найденное решение.

Итак, смотрим код:

Public Function СуммаПрописью(x As Double) As String

If x > 999999999999.99 Then
СуммаПрописью = “Аргумент больше 999 999 999 999.99!”
ElseIf x < 0 Then
СуммаПрописью = “Аргумент отрицательный!”
Else
x = FormatNumber(x, 2)
Dim b As Byte, b1 As Byte, b2 As Byte, kop As String
b = (x – Fix(x)) * 100
b2 = b 10
b1 = b Mod 10
If b2 <> 1 And b1 = 1 Then
kop = ” тиын”
ElseIf b2 <> 1 And b1 > 1 And b1 < 5 Then
kop = ” тиын”
Else
kop = ” тиын”
End If
kop = b2 & b1 & kop
Dim y(1 To 4) As Integer, i1 As Byte
For i1 = 1 To 4
x = Fix(x) / 1000
y(i1) = (x – Fix(x)) * 1000
Next

Dim Text(1 To 4) As String, i2 As Byte, y1 As Byte, y2 As Byte, _
y3 As Byte, Text0 As String, Text1 As String, Text2 As String, Text3 As String, _
Text4 As String
For i2 = 1 To 4
y1 = y(i2) Mod 10
y2 = (y(i2) – y1) / 10 Mod 10
y3 = y(i2) 100
Text1 = Choose(y3 + 1, “”, “сто “, “двести “, “триста “, “четыреста “, _
“пятьсот “, “шестьсот “, “семьсот “, “восемьсот “, “девятьсот “)
Text2 = Choose(y2 + 1, “”, “”, “двадцать “, “тридцать “, “сорок “, _
“пятьдесят “, “шестьдесят “, “семьдесят “, “восемьдесят “, “девяносто “)
If y2 = 1 Then
Text3 = Choose(y1 + 1, “десять “, “одиннадцать “, “двенадцать “, _
“тринадцать “, “четырнадцать “, “пятнадцать “, “шестнадцать “, _
“семнадцать “, “восемнадцать “, “девятнадцать “)
ElseIf y2 <> 1 And i2 = 2 Then
Text3 = Choose(y1 + 1, “”, “одна “, “две “, “три “, “четыре “, “пять “, _
“шесть “, “семь “, “восемь “, “девять “)
Else
Text3 = Choose(y1 + 1, “”, “один “, “два “, “три “, “четыре “, “пять “, _
“шесть “, “семь “, “восемь “, “девять “)
End If

If y2 <> 1 And y1 = 1 Then
Text4 = Choose(i2, “тенге “, “тысяча “, “миллион “, “миллиард “)
ElseIf y2 <> 1 And y1 > 1 And y1 < 5 Then
Text4 = Choose(i2, “тенге “, “тысячи “, “миллиона “, “миллиарда “)
ElseIf y1 = 0 And y2 = 0 And y3 = 0 Then
Text4 = Choose(i2, “тенге “, “”, “”, “”)
Else
Text4 = Choose(i2, “тенге “, “тысяч “, “миллионов “, “миллиардов “)
End If
Text(i2) = Text1 & Text2 & Text3 & Text4
Next
If y(1) + y(2) + y(3) + y(4) = 0 Then
Text0 = “ноль тенге ” & kop
Else
Text0 = Text(4) & Text(3) & Text(2) & Text(1) & kop
End If
СуммаПрописью = Replace(Text0, Left(Text0, 1), UCase(Left(Text0, 1)), 1, 1)
End If
End Function

Добавим код в Excel.

Обратите внимание, что вместо слов «тенге» и «тиын» вы поставите свои варианты. В России это будут соответственно рубли и копейки, в США доллары и центы, у остальных свои признаки. Можно вообще убрать эти названия, тогда получим только значения в виде текста.

Данный код можно вставить непосредственно в файл, однако это не выход. Мало того, что файл придется сохранять как файл с поддержкой макросов, так еще и в других файлах придется заново подключать функцию. Поступим по-другому.

1. Создадим новый файл. Зайдем на вкладку «Вид», перейдем в блок «Макросы» и дадим команду «Запись макроса». Название не трогаем, но местом хранения укажем личную книгу макросов, как на рисунке.

После этого, не выполняя никаких действий, вновь переходим «ВИД» → «МАКРОСЫ» → «Остановить запись. Эти действия необходимы для получения доступа к личной книге макросов.

2. Нажимаем сочетание клавиш «Alt + F11». Это значит, что надо нажать клавишу Alt и , не отпуская ее, клавишу F11 в верхнем ряду клавиатуры. На ноутбуке, вероятно, надо дополнительно удерживать клавишу Fn внизу рядом с клавишей Ctrl. Это уже зависит от настройки ноутбука. Если у вас активна вкладка «разработчик», то можно нажать соответствующую кнопку в ней.

3. В результате откроется окно редактора VBA. С левой стороны щелкаем по элементу «VBAProject (PERSONAL.XLSB)». Это и есть наша личная книга макросов.

4. На следующем шаге выбираем в верхнем меню команду «Insert» → «Module». Откроется пустое окно , в которое и копируем указанный выше код.

5. Закрываем редактор VBA и файл Excel, соглашаясь с изменениями в личной книге макросов. Сам файл Excel сохранять не надо!

 Применение функции 

 Применение созданной функции “СуммаПрописью” позволит легко преобразовать числовое значение в число прописью в текстовом виде. Выбираем ячейку рядом с той, которая содержит числовые значения и нажимаем на кнопку вставки функции или сочетание клавиш «Shift + F3». В списке категорий находим вариант «Определенные пользователем», а внизу – нашу функцию.

Щелкаем в появившемся окне по ячейке с цифрами:

И любуемся результатом.
Конечно никто не мешает протянуть формулу вниз, чтобы применить ее к нижним ячейкам. Получившиеся в итоге формулы можно скопировать и вставить с виде только значений.

После этого начальный диапазон с формулами можно удалить. Обратите внимание, что у вас не получиться вставить в виде значений формулу, если вы не скопируете ячейки с ней, а вырежете.

Коррекция функции.

Желающие могут поэкспериментировать с функцией, например изменив, как я, названия валюты. Еще пример – разделить по знаку «запятая» значения в ячейках, применить функцию по отдельности к каждой части, а затем соединить результат в одно целое c помощью функций сцепить. В этом случае лучше для знаков после запятой использовать копию указанной функции.  Замените в ней нужные места на свои. В частности, вместо слов «сто» и «тысяча» необходимо будет написать «сотых» и «тысячных», ну и так далее.  Предлагаю включить вашу фантазию. Кроме этого, если у вас английская версия Windows, то, скорее всего, название функции выйдет в виде иероглифов. Тогда в тексте функции надо поменять везде название на русском языке на название латинскими символами, например вместо СуммаПрописью вставит ValueToText. 

На этом наше небольшое занятие подходит к концу. Всем удачи!

PS.  В зависимости от браузера возможны проблемы с копированием текста модуля. Это может быть связано с кодировкой, неверным отображением кавычек и прочими нюансами. Поэтому  выкладываю для скачивания свой готовый модуль, который достаточно просто импортировать в личную книгу макросов.

Ссылка на модуль. .

Часто нужно перевести число в текст в Excel так, чтобы оно отображалось прописью (словами) на русском или других языках. Так как по умолчанию нет готовой функции, создадим свою пользовательскую функцию с помощью макросов.

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

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

1. Открыть редактор макросов ALT+F11.
2. Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».



3. Вставить в модуль следующий код и сохранить:



Можно написать алгоритм макро программы по-другому и еще сделать так, чтобы она дописывала валюту суммы прописью. Для этого создайте Module2 и введите в него следующий код:

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

Private Sub Workbook_Open()
DescribeFunction
End Sub
 

Кроме того благодаря данному макросу DescribeFunction функция будет доступна в группе: «ФОРМУЛЫ»-«Библиотека функций»-«Финансовые»-«ЧислоПрописьюВалюта»

Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:

• 1-рубли;
• 2-доллары;
• 0-евро;

Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).

Скачать число прописью в Excel руб RUB.

Украинская версия функции ЧислоСловоВалюта для перевода сумм в гривны находиться в следующем файле:

Скачать функцию ЧислоСловоВалюта ГРН UAH

Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.

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

Немного теории

Любая сумма имеет целую часть (рубли) и, иногда, дробную (копейки). С копейками все понятно — они обычно пишутся цифрами. С рублями все несколько сложнее. Самая большая загвоздка — это разрядность. Хотя, если подумать, то не такая уж это и проблема. Весь алгоритм несколько похож на алгоритм склонения ФИО по падежам, а именно — подставить нужное окончание. Разница лишь в том, что имена не все предсказуемы, а с числами все проще.

Функция разбиения на разряды

Поскольку задача написания числа прописью достаточно сложная, то есть смысл ее разбить на мелкие. Для начала, мы разобьем число на разряды и уже каждый разряд будем переводить в пропись.

Public Function IntToWords(s)
    Dim i, count
 
 ' если длина строки 0 или значение 0
    If (Len(s) = 0) Or (s = "0") Then
        IntToWords = "ноль"
        Exit Function
    End If
 
 ' определим количество разрядов
    count = (Len(s) + 2)  3
 
 ' если количество разрядов больше 7, тогда говорим, что не можем прописать словами
    If count > 7 Then
        IntToWords = "Value is too large"
        Exit Function
    End If
 
    result = ""
    s = "00" + s
 
 ' поразрядно переводим число в слова
    For i = 1 To count
        result = ShortNum((Mid(s, Len(s) - 3 * i + 1, 3)), i - 1) + result
    Next
 
    If Len(result) > 0 Then
        result = Right(result, Len(result) - 1)
    End If
 
    IntToWords = result
End Function

Самое интересное — функция ShortNum. Именно она пишет числа прописью.

Число прописью

Public Function ShortNum(num, razr)
 
 Dim hundreds, tens, ones, razryad
 
 ' сотни
 hundreds = Array("", " сто", " двести", " триста", " четыреста", " пятьсот", " шестьсот", " семсот", " восемьсот", " девятьсот")
 
 ' десятки
 tens = Array("", "", " двадцать", " тридцать", " сорок", " пятьдесят", " шестьдесят", " семьдесят", " восемьдесят", " девяносто")
 
 ' единицы
 ones = Array("", "", "", " три", " четыре", " пять", " шесть", " семь", " восемь", " девять", " десять", " одиннадцать", " двенадцать", " тринадцать", " четырнадцать", " пятнадцать", " шестнадцать", " семнадцать", " восемнадцать", " девятнадцать")
 
 ' разряды
 razryad = Array("", " тысяч", " миллион", " миллиард", " триллион", " квадриллион", " квинтиллион")
 
 Dim t, o 'десятки 'единицы
 
 result = hundreds(num  100)
 
 ' если число 0, тогда ничего делать не нужно
 If num = 0 Then Exit Function
 
 ' определим десятки
    t = (num Mod 100)  10
 
 ' определим единицы
    o = num Mod 10
 
 ' подставим число прописью и добавим соответствующее окончание
    If t <> 1 Then
        result = result + tens(t)
        Select Case o
            Case 1
                If razr = 1 Then
                    result = result + " одна"
                Else
                    result = result + " один"
                End If
            Case 2
                If razr = 1 Then
                    result = result + " две"
                Else
                    result = result + " два"
                End If
            Case 3, 4, 5, 6, 7, 8, 9
                result = result + ones(o)
        End Select
 
        result = result + razryad(razr)
 
        Select Case o
            Case 1
                If razr = 1 Then
                    result = result + "а"
                End If
            Case 2, 3, 4
                If razr = 1 Then
                    result = result + "и"
                Else
                    If (razr > 1) Then
                        result = result + "а"
                    End If
                End If
            Case 5, 6, 7, 8, 9, 0
                If (razr > 1) Then
                    result = result + "ов"
                End If
        End Select
 
 Else
  result = result + ones(num Mod 100)
  result = result + razryad(razr)
 
  If razr > 1 Then
   result = result + "ов"
  End If
 End If
 
 ShortNum = result
 
End Function

Функция для формулы

Для наглядного примера можно использовать формулу. Для этого создадим функцию, которую потом вставим в формулу

Public Function sum_in_words(s)
    Dim units As String ' рубли
    Dim subunits As Long ' копейки
    Dim unit_string As String ' рубли прописью
 
 ' если пусто, тогда ничего делать не будем
    If s = "" Then
        sum_in_words = ""
        Exit Function
    End If
 
 ' выделим рубли из числа
    units = Int(s)
 
 ' выделим копейки из числа
    subunits = Round(Abs(s) - Abs(units), 2) * 100
 
 ' переведем число рублей в слова
    unit_string = IntToWords(units) & " руб."
 
 ' припишем копейки.
 ' копейки обычно пишутся числом, соответственно, 
 ' нам нужно добавить 0 перед копейками, если их меньше 10
    If subunits < 10 Then
        sum_in_words = unit_string & " 0" & subunits & " коп."
    Else
        sum_in_words = unit_string & " " & subunits & " коп."
    End If
End Function

И, собственно, формула:
=quantity_in_words(A1)

При внесении информации в разные экономические документы иногда по регламенту требуется вписать сумму прописью. Если речь идет о единичных случаях, то проблем не возникнет. Но при заполнении большого числа документов на это уходит больше времени, чем при заполнении цифрами. Выясним, как установить инструмент, позволяющий автоматически вписать сумму прописью в Excel.

Зачем это нужно

Число, указанное прописью, применяют во многих бухгалтерских документов. Если фирма использует специальные программы, например 1С для формирования отчетности, то такой потребности не возникнет. Но когда нужно ввести сумму прописью при заполнении бумаг в обычных программах, могут возникнуть проблемы. Это требует большого количества времени, поэтому встает вопрос об автоматизации процесса.

Кроме специалистов, которым на работе нужно указать буквенное значение числа, обычным пользователям тоже может потребоваться такой ввод для своих личных целей.

Использование надстройки

В Экселе отсутствует стандартный инструмент, позволяющий добавить сумму прописью, для этого применяют специальные надстройки. Одна из популярных надстроек — NUM2TEXT, которую можно скачать бесплатно. Она меняет цифровые значения на буквенные с помощью Мастера функций. Предварительно необходимо загрузить и сохранить на жестком диске компьютера файл NUM2TEXT.xla.

Преобразовать числа в текст прописью в Excel 2007, 2010, 2016, можно следующим образом:

1. Запустить Эксель и зайти в раздел «файл».
2. Кликнуть на строку «параметры».
3. Откроется окошко, в котором необходимо перейти в пункт «надстройки».
4. Внизу в строке «управление» поставить значение «надстройки Эксель» и щелкнуть на элемент «перейти».
5. Появится маленькое окно, в котором требуется нажать на кнопку «обзор».
6. В появившемся окошке найти предварительно скачанный файл, выделить его и кликнуть на ОК.
7. Инструмент появился в доступных надстройках. Поставить галочку в квадратике рядом с ним и снова щелкнуть мышкой на ОК.
8. Теперь нужно проверить функционирование надстройки. Для этого в любой ячейке ввести произвольное число.
9. Выделить любой другой элемент и кликнуть на ярлычок «вставить функцию», находящийся с левой стороны от строчки формулы.
10. Открыть мастер функций, в предложенном списке найти «сумма прописью». Выделить ее и кликнуть на ОК.
11. В окошке «аргументы функции» в строке «сумма» вписать нужное числовое значение. Оно сразу отобразится в указанной области в рублях и копейках прописью.
12. В строчке можно указать адрес любой ячейки. Возможны 2 варианта – ручным способом через запись координат или простым нажатием на нее в тот момент, когда указатель мышки стоит в поле «сумма». Щелкнуть на ОК.
13. Далее цифра, введенная в ячейку, отобразится в стоимостном выражении прописью в той клетке, где стоит формула.

Использование формулы

Опцию записи значения прописью можно запустить вручную, не прибегая к помощи мастера функций. Но для преобразования числа в текст сначала нужно составить формулу. Примеры различных формул под разные требования можно найти на специализированном форуме.

Синтаксис обычно такой: Сумма_прописью (сумма) или Сумма_прописью (координаты_ячейки).

Если пользователь напечатает в ячейке формулу =Сумма_прописью (74) и нажмет на клавишу ENTER, то в ней автоматически появится текст «семьдесят четыре рубля 00 копеек» (с копейками или без зависит от самой формулы).

Если пользователь напечатает в ячейке =Сумма прописью (А3), то цифра, стоящая в клетке А3, отобразится в запрашиваемом формате.

Скрипт VBA

Далее представлена подготовленная функция на VBA для пользователей, которая переведет цифровой показатель от 0 до 9 999 999 в его текстовое выражение, т.е. в сумму прописью. Сначала ее потребуется занести в книгу. Алгоритм действий:

• нажимают одновременно на ALT+F11, откроется редактор Visual Basic;
• добавляют новый пустой модуль посредством меню Insert – Module;
• копируют и добавляют туда скрипт:

Function СУММАПРОПИСЬЮ(n As Double) As String
 
 Dim Nums1, Nums2, Nums3, Nums4 As Variant
 
 Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
 Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
 Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ",  "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
 If n <= 0 Then
   СУММАПРОПИСЬЮ = "ноль"
   Exit Function
 End If
 'разделяем число на разряды, используя вспомогательную функцию Class
 ed = Class(n, 1)
 dec = Class(n, 2)
 sot = Class(n, 3)
 tys = Class(n, 4)
 dectys = Class(n, 5)
 sottys = Class(n, 6)
 mil = Class(n, 7)
 decmil = Class(n, 8)
 'проверяем миллионы
 Select Case decmil
   Case 1
     mil_txt = Nums5(mil) & "миллионов "
     GoTo www
   Case 2 To 9
     decmil_txt = Nums2(decmil)
 End Select
 Select Case mil
   Case 1
     mil_txt = Nums1(mil) & "миллион "
   Case 2, 3, 4
     mil_txt = Nums1(mil) & "миллиона "
   Case  5 To 20
     mil_txt = Nums1(mil) & "миллионов "
 End Select
 www:
 sottys_txt = Nums3(sottys)
 'проверяем тысячи
 Select Case dectys
   Case 1
     tys_txt = Nums5(tys) & "тысяч "
     GoTo eee
   Case 2 To 9
     dectys_txt = Nums2(dectys)
 End Select
 Select Case tys
   Case 0
     If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч "
   Case 1
     tys_txt = Nums4(tys) & "тысяча "
   Case 2, 3, 4
     tys_txt = Nums4(tys) & "тысячи "
   Case 5 To 9
     tys_txt = Nums4(tys) & "тысяч "
 End Select
 If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч "
 eee:
 sot_txt = Nums3(sot)
 'проверяем десятки
 Select Case dec
   Case 1
     ed_txt = Nums5(ed)
     GoTo rrr
   Case 2 To 9
     dec_txt = Nums2(dec)
 End Select
 ed_txt = Nums1(ed)
 rrr:
 'формируем итоговую строку
 СУММАПРОПИСЬЮ = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
End Function
'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, I)
  Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))
End Function

Сохраняют файл и возвращаются в Excel. Затем вставляют функцию в любую клетку листа книги привычным способом — через мастер функций или просто набирают ее в ячейке вручную, а в качестве аргумента указывают ячейку с суммой.

'Сумма Прописью по Владимиру Яркову (короткая)
'Владимир Ярков
'Функция вывода суммы прописью в рублях и цифрами в копейках
'синтаксис: fSUMprop(число[,вариант])
'знак числа не учитывается
'первый аргумент - число (Variant) до 10 триллионов
'второй аргумент =0 - возвращает сумму с первой прописной,
' остальные - строчными буквами
' <>0 возвращает сумму строчными буквами
Public Function fSUMprop(xsu As Variant, Optional mb As Byte) As String
On Error GoTo ersupr
If Not IsNumeric(xsu) Then
 fSUMprop = ""
 Exit Function
End If
If xsu >= 10000000000000# Then
 fSUMprop = "слишком большое число"
 Exit Function
End If
Dim ssu As String, nsu, edi, des, sot, ind As Byte, i As Integer
If Fix(xsu) = 0 Then
 fSUMprop = "ноль рублей "
Else
 ssu = Mid$(Str$(Fix(xsu)), 2) ' строка рублей без знака
 nsu = (Len(ssu) + 2)  3 ' количество троек цифр
 ssu = Right$("00", nsu * 3 - Len(ssu)) + ssu ' добавляем нулями
 For i = nsu To 1 Step -1
 sot = Val(Mid$(ssu, (nsu - i) * 3 + 1, 1)) ' сотни
 des = Val(Mid$(ssu, (nsu - i) * 3 + 2, 1)) ' десятки
 edi = Val(Mid$(ssu, (nsu - i) * 3 + 3, 1)) ' единицы
 If sot + des + edi > 0 Or i = 1 Then
 If sot > 0 Then
 fSUMprop = fSUMprop + Choose(sot, "сто", "двести", "триста", _
 "четыреста", "пятьсот", "шестьсот", "семьсот", "восемьсот", _
 "девятьсот") + " "
 End If
 If des = 1 Then
 fSUMprop = fSUMprop + Choose(edi + 1, "десять", "одиннадцать", _
 "двенадцать", "тринадцать", "четырнадцать", "пятнадцать", "шестнадцать", _
 "семнадцать", "восемнадцать", "девятнадцать") + " "
 ind = 3
 Else
 If des <> 0 Then
 fSUMprop = fSUMprop + Choose(des - 1, "двадцать", _
 "тридцать", "сорок", "пятьдесят", "шестьдесят", "семьдесят", "восемьдесят", _
 "девяносто") + " "
 End If
 If edi <> 0 Then ' вычисляем индекс для тысяч (одна,две)
 If i = 2 And (edi = 1 Or edi = 2) Then
 ind = 9
 Else
 ind = 0
 End If
 fSUMprop = fSUMprop + Choose(edi + ind, "один", "два", _
 "три", "четыре", "пять", "шесть", "семь", "восемь", "девять", "одна", _
 "две") + " "
 End If
 Select Case edi
 Case 1
 ind = 1
 Case 2, 3, 4
 ind = 2
 Case Else
 ind = 3
 End Select
 End If
 fSUMprop = fSUMprop + Choose((i - 1) * 3 + ind, "рубль", "рубля", _
 "рублей", "тысяча", "тысячи", "тысяч", "миллион", "миллиона", "миллионов", _
 "миллиард", "миллиарда", "миллиардов", "триллион", "триллиона", _
 "триллионов") + " "
 End If
 Next i
End If
ssu = Right$(Format$(xsu, "0.00"), 2)
des = Val(Left$(ssu, 1))
edi = Val(Right$(ssu, 1))
If des = 1 Then
 ind = 3
Else
 Select Case edi
 Case 1
 ind = 1
 Case 2, 3, 4
 ind = 2
 Case Else
 ind = 3
 End Select
End If
fSUMprop = fSUMprop + ssu + Choose(ind, " копейка", " копейки", " копеек")
If mb = 0 Then
 fSUMprop = UCase$(Left$(fSUMprop, 1)) + Mid$(fSUMprop, 2)
End If
Exit Function
ersupr:
fSUMprop = "ошибка"
End Function

В прикрепленном файле бухгалтерская форма «Счет» с примером использования функции

Очень распространенная задача написать числа прописью в Excel. Встроенной функции пока еще в Excel нет, поэтому мы можем создать пользовательскую функцию, которая и будет заменять цифры, числа текстом.

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

Смотрите также: Как написать сумму прописью на украинском языке

Сумма в рублях, долларах или евро с копейками прописью

Допустим, мы делаем какие-то расчеты в таблице и получаем итоговую сумму в рублях 1526,23

Нам необходимо прописать эту цифру в рублях и желательно указать так же и копейки. Для этого создадим специальную универсальную пользовательскую функцию, которая будет выглядеть следующим образом

Propis(Amount;Money;lang;Prec)

где

Amount — это ссылка на ячейку с числом

Money — тут указывается вид валюты, можно указать рубли, доллары и евро («RUB», «USD», «EUR») — валюта обязательно указывается в кавычках.

lang — это язык на котором необходимо вывести сумму, доступно два языка английский и русский («EN», «RU») — так же указываем в кавычках

Prec — показывать (1) или не показывать (0) дробную часть

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

Чтобы создать пользовательскую функцию Propis, необходимо скопировать код, указанный ниже, далее нажмите ALT+F11, чтобы открыть VBA, добавьте новый пустой модуль через меню Insert — Module и вставьте туда скопированный код

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

Function Propis(Amount As String, Optional Money As String = "RUB", Optional lang As String = "RU", Optional Prec As Integer = 1)
 Dim whole As Double

 Amount = Replace(Amount, "-", Application.International(xlDecimalSeparator))
 Amount = Replace(Amount, ".", Application.International(xlDecimalSeparator))
 Amount = Replace(Amount, ",", Application.International(xlDecimalSeparator))

 Sum = WorksheetFunction.Round(CDbl(Amount), 2)
 Money = UCase(Money)
 lang = UCase(lang)
 whole = Int(Sum)
 fraq = Format(Round((Sum - whole) * 100), "00")

 Select Case Class(whole, 1) + Class(whole, 2) * 10
 Case 1, 21, 31, 41, 51, 61, 71, 81, 91
 w_rus_r = "рубль"
 w_rus_d = "доллар"
 w_rus_e = "евро"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"

 Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
 w_rus_r = "рубля"
 w_rus_d = "доллара"
 w_rus_e = "евро"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"

 Case Else
 w_rus_r = "рублей"
 w_rus_d = "долларов"
 w_rus_e = "евро"
 w_en_r = "rubles"
 w_en_d = "dollars"
 w_en_e = "euro"

 End Select

 Select Case fraq
 Case 1, 21, 31, 41, 51, 61, 71, 81, 91
 f_rus_r = "копейка"
 f_rus_d = "цент"
 f_rus_e = "цент"
 f_rus_p = "сотая"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 f_en_e = "cents"

 Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94
 f_rus_r = "копейки"
 f_rus_d = "цента"
 f_rus_e = "цента"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 Case Else
 f_rus_r = "копеек"
 f_rus_d = "центов"
 f_rus_e = "центов"
 f_en_r = "kopecks"
 f_en_d = "cents"
 f_en_e = "cents"
 End Select

 If Prec = 0 Then
 fraq = ""
 f_rus_r = ""
 f_rus_d = ""
 f_rus_e = ""
 f_en_r = ""
 f_en_d = ""
 f_en_e = ""
 End If

 If lang = "RU" Then
 Select Case Money
 Case "RUB"
 Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r
 Case "USD"
 Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d
 Case "EUR"
 Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e
 End Select
 End If

 If lang = "EN" Then
 Select Case Money
 Case "RUB"
 Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r
 Case "USD"
 Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d
 Case "EUR"
 Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e
 End Select
 End If

 Propis = WorksheetFunction.Trim(Out)

End Function

Private Function Class(m, i)
 Class = Int(Int(m - (10 ^ i) * Int(m / (10 ^ i))) / 10 ^ (i - 1))
End Function

Private Function ScriptRus(n As Double) As String
 Dim Nums1, Nums2, Nums3, Nums4 As Variant
 Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
 Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
 Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")

 If n = 0 Then
 ScriptRus = "Ноль"
 Exit Function
 End If
 ed = Class(n, 1)
 dec = Class(n, 2)
 sot = Class(n, 3)
 tys = Class(n, 4)
 dectys = Class(n, 5)
 sottys = Class(n, 6)
 mil = Class(n, 7)
 decmil = Class(n, 8)
 sotmil = Class(n, 9)
 mlrd = Class(n, 10)

 If mlrd > 0 Then
 Select Case mlrd
 Case 1
 mlrd_txt = Nums1(mlrd) & "миллиард "
 Case 2, 3, 4
 mlrd_txt = Nums1(mlrd) & "миллиарда "
 Case 5 To 20
 mlrd_txt = Nums1(mlrd) & "миллиардов "
 End Select
 End If
 If (sotmil + decmil + mil) > 0 Then
 sotmil_txt = Nums3(sotmil)

 Select Case decmil
 Case 1
 mil_txt = Nums5(mil) & "миллионов "
 GoTo www
 Case 2 To 9
 decmil_txt = Nums2(decmil)
 End Select

 Select Case mil
 Case 1
 mil_txt = Nums1(mil) & "миллион "
 Case 2, 3, 4
 mil_txt = Nums1(mil) & "миллиона "
 Case 0, 5 To 20
 mil_txt = Nums1(mil) & "миллионов "
 End Select
 End If
www:
 sottys_txt = Nums3(sottys)
 Select Case dectys
 Case 1
 tys_txt = Nums5(tys) & "тысяч "
 GoTo eee
 Case 2 To 9
 dectys_txt = Nums2(dectys)
 End Select

 Select Case tys
 Case 0
 If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч "
 Case 1
 tys_txt = Nums4(tys) & "тысяча "
 Case 2, 3, 4
 tys_txt = Nums4(tys) & "тысячи "
 Case 5 To 9
 tys_txt = Nums4(tys) & "тысяч "
 End Select
 If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тысяч "
eee:
 sot_txt = Nums3(sot)

 Select Case dec
 Case 1
 ed_txt = Nums5(ed)
 GoTo rrr
 Case 2 To 9
 dec_txt = Nums2(dec)
 End Select

 ed_txt = Nums1(ed)
rrr:

 ScriptRus = mlrd_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
 ScriptRus = UCase(Left(ScriptRus, 1)) & LCase(Mid(ScriptRus, 2, Len(ScriptRus) - 1))
 End Function

Private Function ScriptEng(ByVal Number As Double)
 Dim BigDenom As String, Temp As String
 Dim Count As Integer

 ReDim Place(9) As String
 Place(2) = " Thousand "
 Place(3) = " Million "
 Place(4) = " Billion "
 Place(5) = " Trillion "

 strAmount = Trim(Str(Int(Number)))

 Count = 1
 Do While strAmount <> ""
 Temp = GetHundreds(Right(strAmount, 3))
 If Temp <> "" Then BigDenom = Temp & Place(Count) & BigDenom
 If Len(strAmount) > 3 Then
 strAmount = Left(strAmount, Len(strAmount) - 3)
 Else
 strAmount = ""
 End If
 Count = Count + 1
 Loop
 Select Case BigDenom
 Case ""
 BigDenom = "Zero "
 Case "One"
 BigDenom = "One "
 Case Else
 BigDenom = BigDenom & " "
 End Select
 ScriptEng = BigDenom

End Function

Private Function GetHundreds(ByVal MyNumber)
 Dim result As String
 If Val(MyNumber) = 0 Then Exit Function
 MyNumber = Right("000" & MyNumber, 3)

 If Mid(MyNumber, 1, 1) <> "0" Then
 result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
 End If

 If Mid(MyNumber, 1, 1) <> "0" And (Mid(MyNumber, 2, 1) <> "0" Or Mid(MyNumber, 3, 1) <> "0") Then
 result = result & "And "
 End If

 If Mid(MyNumber, 2, 1) <> "0" Then
 result = result & GetTens(Mid(MyNumber, 2))
 Else
 result = result & GetDigit(Mid(MyNumber, 3))
 End If
 GetHundreds = result
End Function
Private Function GetTens(TensText)
 Dim result As String
 result = ""
 If Val(Left(TensText, 1)) = 1 Then
 Select Case Val(TensText)
 Case 10: result = "Ten"
 Case 11: result = "Eleven"
 Case 12: result = "Twelve"
 Case 13: result = "Thirteen"
 Case 14: result = "Fourteen"
 Case 15: result = "Fifteen"
 Case 16: result = "Sixteen"
 Case 17: result = "Seventeen"
 Case 18: result = "Eighteen"
 Case 19: result = "Nineteen"
 Case Else
 End Select
 Else
 Select Case Val(Left(TensText, 1))
 Case 2: result = "Twenty "
 Case 3: result = "Thirty "
 Case 4: result = "Forty "
 Case 5: result = "Fifty "
 Case 6: result = "Sixty "
 Case 7: result = "Seventy "
 Case 8: result = "Eighty "
 Case 9: result = "Ninety "
 Case Else
 End Select
 result = result & GetDigit _
 (Right(TensText, 1))
 End If
 GetTens = result
End Function
Private Function GetDigit(Digit)
 Select Case Val(Digit)
 Case 1: GetDigit = "One"
 Case 2: GetDigit = "Two"
 Case 3: GetDigit = "Three"
 Case 4: GetDigit = "Four"
 Case 5: GetDigit = "Five"
 Case 6: GetDigit = "Six"
 Case 7: GetDigit = "Seven"
 Case 8: GetDigit = "Eight"
 Case 9: GetDigit = "Nine"
 Case Else: GetDigit = ""
 End Select
End Function

Итак, функция создана, чтобы воспользоваться ей, просто введите ячейке Propis с нужными аргументами, например, если нам необходимо прописать сумму прописью в рублях с копейками и на русском языке, то формула будет выглядеть следующим образом.

=Propis(B2;"RUB";"RU";1)

Числа прописью с копейками  заглавными или строчными буквами в Excel

Вот код VBA для пользовательской функции. Отображение суммы прописью с копейками и выбором первой заглавной или строчной буквы

Function РубПропись(Сумма As Double, Optional Без_копеек As Boolean = False, _
 Optional КопПрописью As Boolean = False, Optional начинитьПрописной As Boolean = True) As String
'Функция для написания суммы прописью
 Dim ed, des, sot, ten, razr, dec
 Dim i As Integer, str As String, s As String
 Dim intPart As String, frPart As String
 Dim mlnEnd, tscEnd, razrEnd, rub, cop
 
 dec = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 ten = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
 des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
 sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
 razr = Array("", "тысяч", "миллион", "миллиард")
 mlnEnd = Array("ов ", " ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ")
 tscEnd = Array(" ", "а ", "и ", "и ", "и ", " ", " ", " ", " ", " ")
 razrEnd = Array(mlnEnd, mlnEnd, tscEnd, "")
 rub = Array("рублей", "рубль", "рубля", "рубля", "рубля", "рублей", "рублей", "рублей", "рублей", "рублей")
 cop = Array("копеек", "копейка", "копейки", "копейки", "копейки", "копеек", "копеек", "копеек", "копеек", "копеек")
 If Сумма >= 1000000000000# Or Сумма < 0 Then РубПропись = CVErr(xlErrValue): Exit Function
 '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
 If Round(Сумма, 2) >= 1 Then
 intPart = Left$(Format(Сумма, "000000000000.00"), 12)
 For i = 0 To 3
 s = Mid$(intPart, i * 3 + 1, 3)
 If s <> "000" Then
 str = str & sot(CInt(Left$(s, 1)))
 If Mid$(s, 2, 1) = "1" Then
 str = str & ten(CInt(Right$(s, 1)))
 Else
 str = str & des(CInt(Mid$(s, 2, 1))) & IIf(i = 2, dec(CInt(Right$(s, 1))), ed(CInt(Right$(s, 1))))
 End If
 On Error Resume Next
 str = str & IIf(Mid$(s, 2, 1) = "1", razr(3 - i) & razrEnd(i)(0), _
 razr(3 - i) & razrEnd(i)(CInt(Right$(s, 1))))
 On Error GoTo 0
 End If
 Next i
 str = str & IIf(Mid$(s, 2, 1) = "1", rub(0), rub(CInt(Right$(s, 1))))
 End If
 РубПропись = str
 ''''''''''''''''''
 If Без_копеек = False Then
 frPart = Right$(Format(Сумма, "0.00"), 2)
 If frPart = "00" Then
 frPart = ""
 Else
 If КопПрописью Then
 frPart = IIf(Left$(frPart, 1) = "1", ten(CInt(Right$(frPart, 1))) & cop(0), _
 des(CInt(Left$(frPart, 1))) & dec(CInt(Right$(frPart, 1))) & cop(CInt(Right$(frPart, 1))))
 Else
 frPart = IIf(Left$(frPart, 1) = "1", frPart & " " & cop(0), frPart & " " & cop(CInt(Right$(frPart, 1))))
 End If
 End If
 РубПропись = str & " " & frPart
 End If
 ''''''''''''''''''
' РубПропись = str & frPart
 If начинитьПрописной Then Mid$(РубПропись, 1, 1) = UCase(Mid$(РубПропись, 1, 1))
' If начинитьПрописной Then РубПропись = UCase(Left(РубПропись, 1)) & Mid(РубПропись, 2)
End Function

• Без копеек (1), с копейками (0)
• Копейки прописью (1), числом (0)
• Начинать прописью (0), заглавной (1)

Вот как используется функция

Примечание

• Данная функция будет работать с числами от 0 до 99 999 999
• Перед копирование кода переключите раскладку клавиатуры на русский язык (для корректного копирования русского текста)
• Код VBA необходимо вставлять во все файлы (Книги Excel), где вы хотите, чтобы она работала
• После вставки код, необходимо сохранить файл с поддержкой макросов xlsm (в Excel, начиная с 2007 версии)
• Функцию можно либо набирать в ручную, либо, если вы забыли как она пишется, через мастер функций (кнопка fx в строке формул, категория Определенные пользователем)