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

Ниже вы найдете готовую пользовательскую функцию на 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. Теперь вы можете вставить созданную функцию в любую ячейку листа этой книги обычным способом - через мастер функций (кнопка fx в строке формул, категория Определенные пользователем) или просто набрав ее в ячейке вручную и указав в качестве аргумента ячейку с суммой:

propis1.gif

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

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

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

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

 

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

 



05.04.2013 14:49:49
Добрый день!
Мне эта функция очень понравилось, очень пригодилась для заполнения препроводительных сумок с денежной наличностью.
Я вижу что есть "Более мощный вариант функции с рублями и копейками на русском/английском из надстройки PLEX", он слишком "крутой" для нас.
Можно ли текущий вариант добавить функционал, чтобы первое слово было с Заглавной буквы, например:
34 руб = "Тридацать четыре рубля"
1 456 789 = "Один миллион четыреста пятьдесят шесть рублей семьсот восемьдесят девять рублей"
Буду очень признателен за помощь, т.к. банк требует первое слово с заглавной буквы.
11.04.2013 08:19:31
Да, конечно. Чтобы любой текст сделать с заглавной буквы, можно применить вот такую формулу:
=ПРОПИСН(ЛЕВСИМВ(А1))&ПСТР(А1;2;ДЛСТР(А1)-1)

где А1 - ячейка с вашим текстом или функция вывода суммы прописью.
11.04.2013 15:22:34
Спасибо!
09.11.2013 02:16:59
Здравствуйте! Не очень понял, куда вставить указанную строчку. У меня стоит такой же макрос, как в примере. Где там добавить эту строчку, чтобы первая цифра была заглавной?
Заранее благодарю!
09.11.2013 09:07:11
Сергей, это не в макрос надо вставить, а на листе в ячейку. Формула будет брать сделанную макросом сумму прописью (из А1) и выводить ее с заглавной буквы.
09.11.2013 13:39:57
Смотрите, у меня вывод суммы прописью идет в определенную ячейку.
Мои действия:
1. Сначала в листе появляется результат макроса с маленькой буквы;
2. Надо написать в другой ячейке эту формулу;
3. Скопировать данные из ячейки с формулой на место где сначала был результат макроса.

Более простого пути нет, чтобы сразу на первом шаге в нужной ячейке появлялась сумма с Заглавной буквы?
30.08.2015 09:43:49
Николай, куда вставить строчку
=ПРОПИСН(ЛЕВСИМВ(А1))&ПСТР(А1;2;ДЛСТР(А1)-1)
,для того, чтобы сумма писалась с заглавной буквы???

Вы говорите, что в ячейку. Но в этой ячейке и так уже есть формула
=СУММАПРОПИСЬЮ(P31)&" руб. "&ТЕКСТ((P31-ЦЕЛОЕ(P31))*100;"00";)&" коп."

Ничего не понятно!
Al
19.04.2017 11:19:22
Используйте следующую формулу:
=ПРОПИСН(ЛЕВСИМВ(СУММАПРОПИСЬЮ(E18)))&ПСТР(СУММАПРОПИСЬЮ(E18);2;ДЛСТР(СУММАПРОПИСЬЮ(E18))-1)&"руб. "&ТЕКСТ((E18-ЦЕЛОЕ(E18))*100;"00";)&" коп."
где E18 - число, которое нужно написать прописью с большой буквы.
MCH
24.04.2013 02:19:30
0,999 =  руб. 100 коп.
???
01.06.2013 14:45:50
тогда:
=ЕСЛИ(ОКРУГЛ(B6-ЦЕЛОЕ(B6);2)=1;СЦЕПИТЬ(СУММАПРОПИСЬЮ(B6+1);" руб. 00 коп.");
СУММАПРОПИСЬЮ(B6)&" руб. "&ТЕКСТ((B6-ЦЕЛОЕ(B6))*100;"00")&" коп.").
MCH
02.06.2013 08:19:58
Александр Т, я не об этом хотел сказать
Функция Николая Павлова не совсем корректна:
1. Не целые значения от 0 до 1 не кореектно обрабатываются, слово "ноль" будет писаться только для n <= 0
да и то не будет писатся вообще, т.к. функция называется СУММАПРОПИСЬЮ а в 15 строке "ноль" присваивается переменной PropisRus

2. Если функция не обрабатывает копейки, то зачем n As Double?
при этом не происходит округления, так 0,995 нужно округлять до целого в большую сторону.
В самой функции можно использовать
n = Int(CDbl(Format(n, "0.00")))
или
n = Int(WorksheetFunction.Round(n, 2))

В данном случае лучше использовать Format (или функцию листа WorksheetFunction.Round), а не  функцию Round из VBA, т.к. Round округляет не по математическим законам округления

3. В слове "тысячa" буква "a" - латинская
02.06.2013 08:28:12
Я предполагал, что исходные аргументы для функции округляет до целого пользователь :) За остальное - спасибо, подправил.
02.06.2013 15:01:01
с VBA не знаком, поэтому работал с тем, что было.
За разъяснения - спасибо: стало намного понятнее!

По-моему, в 14 строке нужно подправить (в случае, если число будет не целое):
If n < 1 Then
13.06.2013 09:44:21
О да, спасибо!
13.06.2013 09:54:12
это Вам - спасибо!
столько нового и полезного узнал!

p.s.: ждем уроков по макросам!
MCH
14.06.2013 12:59:38
За остальное - спасибо, подправил
В приложенном файле-примере не исправлено
08.06.2013 19:31:51
Не работает с большими суммами.
Если в ячейке стоит сумма 321 000 000,01 - то макрос пишет прописью (с учетом добавления формулы) "Двадцать один миллион руб. 01 коп."
Как исправить?
13.06.2013 09:44:02
А прочитать первую строчку этого примера?
13.06.2013 21:42:36
Да, проглядел.
Моя вина.
22.02.2014 10:02:20
Еще можно использовать функцию PROPIS из надстройки PLEX- там рабочий диапазон больше.
Доброе утро всем! Подскажите пожалуйста как сделать чтобы сумма прописью начиналась с заглавной буквы?
02.12.2013 20:40:13
См. комментарии выше - уже был вопрос.
23.10.2017 13:16:29
Николай, здравствуйте. Скажите, пожалуйста, как в конце текста прописать. Без НДС.?? Очень нужно!!:)
17.02.2014 17:34:07
Добрый день, очень понравилась данная функция и она очень удобна!
Хотелось бы узнать, как сделать так, чтобы данная функция была доступна для всех книг EXCEL, а не только для той, в которой заводился макрос?  
22.02.2014 10:00:59
Ольга, если нужно, чтобы на отдельно взятом компьютере эта функция была доступна, то нужно поместить ее в Личную книгу макросов. Если нужно, чтобы функция работала на любом компьютере, то обязательно вставлять ее в книгу.
Спасибо, отличная функция!
30.04.2014 11:34:44
Спасибо, Николай!
Воспользовалась функцией для разработки формы по просьбе бухгалтера. Бухгалтер - счастлив.
07.05.2014 12:11:53
Счастливый бухгалтер - большая редкость, берегите его :)
28.05.2014 05:11:45
Добрый день, Николай! Выполнила все шаги, как у вас, сохранила в формате "Excel с поддержкой макросов", но при вводе формулы вручную (т.к. категория Определенные пользователем у меня не появилась) формула почему-то не работает, всплывает окно с ошибкой "Compile error: Expected: end of statement". Excel 2010. Что можно сделать, подскажите, пожалуйста?
09.06.2014 12:44:56
У вас ошибка в коде - не хватает строки с командой End. Проверьте код еще разок тщательно.
11.06.2014 23:05:11
Друзья нужно чтобы писало на армянском и писало числа с дробями
Заранее спасибо!
14.06.2014 12:30:28
Поиск в Гугле дал первую же ссылку http://freesoft.ru/summa_propisyu
03.09.2014 18:05:24
Здравствуйте!
в Excel есть функция БАТТЕКСТ, которая выполняет аналогичные действия, что и СУММАПРОПИСЬЮ, но только не на русском языке.
в справке Excel написано, что это можно исправить через Панель управления в Windows в Языковых (Региональных) стандартах.
я это попытался сделать, везде выставил "Рус." и т.п., но тем не менее функция БАТТЕКСТ по русски писать не стала.
может кто-нибудь знает, как это можно исправить? подскажите, пожалуйста.

Спасибо!
03.09.2014 18:07:28
Функция БАТТЕКСТ выводит сумму прописью только на тайском языке. На русском языке такой встроенной функции нет, поэтому и была написана эта статья :)
13.10.2014 13:14:59
Добрый день! Очень помогла ваша работа, спасибо! Вопрос: А с диапазоном эта функция не работает? Если несколько строк нужно обработать.
30.10.2014 13:45:06
Здравствуйте!
Возникла проблема. При вставке кода макроса вместо русских букв знаки вопросов. Как это исправить?
06.02.2015 18:33:49
Здравствуйте!
Не полностью пишет целые суммы:
с неровными суммами всё в порядке, а вот с ровными не очень. Сумма больше 9999999...
 33 333 333,00   Тридцать три миллиона триста тридцать три тысячи триста тридцать три
 30 000 000,00   Тридцать
08.02.2015 11:07:36
Как и написано в первой строке этого примера, этот макрос работает только с суммами от 0 до 9 999 999. Так что все ОК :)
16.03.2015 10:50:41
Здравствуйте! Большое спасибо за представленный пример. Подскажите пожалуйста как можно сделать, что бы и отрицательные числа выводились прописью?
24.03.2015 12:47:47
Корректировать код, либо использовать функцию ЕСЛИ, чтобы проверить на отрицательность. Что-то типа:
=ЕСЛИ(A1<0;"Минус "&СуммаПрописью(A1);СуммаПрописью(A1))
24.03.2015 10:00:12
Здравствуйте. Макрос почему то кривой. В евро и долларах суммы пишет с центами и с большой буквы, а в рублях нет.
24.03.2015 12:46:29
О чем вы, Алексей???! Макрос вообще валюту не учитывает никак - посмотрите код. Он только числа в текст переводит без учета денежного формата.
12.05.2015 12:27:42
Подскажите, макрос работает когда рубли от копеек в Excel разделяются знаком ','
Какие настройки нужно изменить, чтобы макрос работал, когда рубли от копеек отделяются "-" (как в платежке)
То есть как пример в ячейке сумма цифрами нужно прописать 260-01  (Если просто заменить ',' на '-' - макрос не работает
09.06.2015 13:11:02
Добрый день!
Подскажите, как сделать, что бы результат отображался в скобках?
250 (двести пятьдесят)
10.06.2015 10:00:26
Мари, нужно подклеить к вашему числу скобки и сумму прописью.
Если ваше число лежит в ячейке A1, то формула будет
=A1&" ("&СУММАПРОПИСЬЮ(A1)&")"
31.08.2015 15:04:59
Уважаемый Николай Павлов,
А можно ли вместо английского или русского писать в VBA на армянском эти цифры? У меня вопросительные знаки вместо букв приводит.
Заранее спасибо!
17.06.2015 09:17:10
Добрый день
Поскажите пожалуйста
почему у меня проблемы с шрифтами в модуле

например СУММАПРОПИСЬЮ ÑÓÌÌÀÏÐÎÏÈÑÜÞ
19.06.2015 15:53:37
Здравствуйте.
Подскажите, что нужно сделать, чтобы в "русском" экселе результат данной формулы выводился на английском языке?
31.08.2015 15:07:38
В Visual Basic переименовать названия чисел с русских на английские.
Я в свое время формулу написал, пользуюсь ей:

 =ЕСЛИ(Ссылка=0;"ноль";СЖПРОБЕЛЫ(ВЫБОР((ОСТАТ(Ссылка;1000000000)-ОСТАТ(Ссылка;100000000))/100000000+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;1;(ОСТАТ(Ссылка;100000000)-ОСТАТ(Ссылка;10000000))/10000000);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(Ссылка;100000000)<19999999;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000+1;"";"одна";"две";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать") & " " & ЕСЛИ(Ссылка<1000000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000=1;"миллион";ЕСЛИ(И((ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000>1;(ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000<5);"миллиона";"миллионов"))) & " " & ВЫБОР((ОСТАТ(Ссылка;1000000)-ОСТАТ(Ссылка;100000))/100000+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;1;(ОСТАТ(Ссылка;100000)-ОСТАТ(Ссылка;10000))/10000);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(Ссылка;100000)<19999;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000+1;"";"одна";"две";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать") & " " & ЕСЛИ(Ссылка<1000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000=1;"тысяча";ЕСЛИ(И((ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000>1;(ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000<5);"тысячи";"тысяч"))) & " " & ВЫБОР((ОСТАТ(Ссылка;1000)-ОСТАТ(Ссылка;100))/100+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100)<20;1;(ОСТАТ(Ссылка;100)-ОСТАТ(Ссылка;10))/10);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100)<20;ОСТАТ(Ссылка;100);ОСТАТ(Ссылка;10))+1;"";"один";"два";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать"))) & " руб. " & ОСТАТ(Ссылка*100;100) & " коп."

В блокноте замените «Ссылка» на нужное...
Можно всегда подправить под себя.
Не требует макроса, спокойно работает в EXCEL 2007
13.10.2015 11:22:37
Анатолий, спасибо за ваш вариант - очень круто, но выглядит убийственно :)
Может кому поможет)
У меня была проблема, пользователей было много, не у всех были разрешены макросы, поэтому надо было думать формулами - во и вышло.
Теперь макросы использую только тогда, когда формулами нереально добиться результата.
24.06.2016 23:52:05
Спасибо! Очень пригодилось для тех, кто пока делёк от макросов  :)
Хотелось бы чуть-чуть усовершенствовать, чтобы до 10 коп. показывало 00, 01, 02 и т.д. Возможно?
26.06.2016 09:20:20
Людмила, посмотрите последние 3 строчки в статье - как раз ответ на ваш вопрос :)
26.06.2016 13:01:09
Спасибо! Получилось! :)
Заменила концовку формулы  ОСТАТ(Ссылка*100;100) & " коп." --> ТЕКСТ((Ссылка-ЦЕЛОЕ(Ссылка)*100;"00") &"  коп."

Пробовала макрос сделать, но, как и у некоторых, отображает кучу вопросительных знаков, кириллицу не воспринимает.
В любом случае, рада, что наткнулась на этот познавательный сайт :D
27.06.2016 09:47:38
Людмила, пришлите файлик мне на почту info@planetaexcel.ru - посмотрю, что не так.
25.08.2016 23:41:34
спасибо за формулу! вещь!
09.02.2018 06:30:43
Отличная формула, но в части копеек работает не очень корректно. Например,
528,17 = пятьсот двадцать восемь руб. 16,9999999999927 коп.,
648,08 = шестьсот сорок восемь руб. 8,00000000000728 коп.,
2589,99 = две тысячи пятьсот восемьдесят девять руб. 98,9999999999709 коп.
И конечно хотелось бы видеть нули в таких суммах, как
628,02 = шестьсот сорок восемь руб. 2 коп.,
800,00 = восемьсот руб. 0 коп.

Слегка исправила окончание формулы, вдруг, кому-то пригодиться через два года после публикации

&ЕСЛИ(ОКРУГЛ(ОСТАТ(B13*100;100);0)<=9;"0"&ОКРУГЛ(ОСТАТ(B13*100;100);0);ОКРУГЛ(ОСТАТ(B13*100;100);0)) & " коп."

Заменить часть формулы после "руб.".
05.02.2019 13:03:21
Спасибо, то что нужно
06.02.2019 04:06:57
На здоровье
16.10.2015 11:40:37
У меня есть в таблица Excel встроенная в документ Word. Подскажите как мне сделать чтобы таблица сохраняла данный макрос? дело в том что я сохранил документ в формате .docm но это не дает результата. (сохраняются макросы для Word в данном случае) а как сделать чтобы была встроена именно таблица с форматом .xlsm и макрос сохранялся.  
02.07.2016 13:34:54
Подскажите пожалуйста в чём проблема. Сразу вставлял ваши формулы и всё работало, а потом в ячейке с формулой стало появляться "#ИМЯ?" (формула содержит нераспознанный текст). Вроде ничего не делал с настройками.
03.07.2016 00:46:29
Уже разобрался. Не в том формате сохранился.
12.08.2016 07:09:01
Добрый день, Николай!
Подскажите пожалуйста, как подправить Ваш макрос, чтобы числа были на английском, например: nine hundred and ninety-eight kilograms
Спасибо!
или может кто поможет подправить эту формулу:
=ЕСЛИ(Ссылка=0;"ноль";СЖПРОБЕЛЫ(ВЫБОР((ОСТАТ(Ссылка;1000000000)-ОСТАТ(Ссылка;100000000))/100000000+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;1;(ОСТАТ(Ссылка;100000000)-ОСТАТ(Ссылка;10000000))/10000000);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(Ссылка;100000000)<19999999;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000+1;"";"одна";"две";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать") & " " & ЕСЛИ(Ссылка<1000000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000=1;"миллион";ЕСЛИ(И((ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000>1;(ЕСЛИ(ОСТАТ(Ссылка;100000000)<20000000;ОСТАТ(Ссылка;100000000);ОСТАТ(Ссылка;10000000))-ОСТАТ(Ссылка;1000000))/1000000<5);"миллиона";"миллионов"))) & " " & ВЫБОР((ОСТАТ(Ссылка;1000000)-ОСТАТ(Ссылка;100000))/100000+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;1;(ОСТАТ(Ссылка;100000)-ОСТАТ(Ссылка;10000))/10000);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(Ссылка;100000)<19999;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000+1;"";"одна";"две";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать") & " " & ЕСЛИ(Ссылка<1000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000=1;"тысяча";ЕСЛИ(И((ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000>1;(ЕСЛИ(ОСТАТ(Ссылка;100000)<20000;ОСТАТ(Ссылка;100000);ОСТАТ(Ссылка;10000))-ОСТАТ(Ссылка;1000))/1000<5);"тысячи";"тысяч"))) & " " & ВЫБОР((ОСТАТ(Ссылка;1000)-ОСТАТ(Ссылка;100))/100+1;"";"сто";"двести";"триста";"четыреста";"пятьсот";"шестьсот";"семьсот";"восемьсот";"девятьсот") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100)<20;1;(ОСТАТ(Ссылка;100)-ОСТАТ(Ссылка;10))/10);"";"двадцать";"тридцать";"сорок";"пятьдесят";"шестьдесят";"семьдесят";"восемьдесят";"девяносто") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(Ссылка;100)<20;ОСТАТ(Ссылка;100);ОСТАТ(Ссылка;10))+1;"";"один";"два";"три";"четыре";"пять";"шесть";"семь";"восемь";"девять";"десять";"одиннадцать";"двенадцать";"тринадцать";"четырнадцать";"пятнадцать";"шестнадцать";"семнадцать";"восемнадцать";"девятнадцать"))) & " руб. " & ОСТАТ(Ссылка*100;100) & " коп."
18.08.2016 08:13:38
Сергей, для английского макрос надо переписывать - там числительные по-другому формируются.
А такую формулу подправлять желающих найдется немного :)
30.08.2016 02:13:03
спасибо создателю формулы.
просто подправил под себя. не стал сокращать, хотя учитывая особенности формирования числительных в английском, точно можно сократить. может кто возьмется. а пока так.

=ЕСЛИ(ССЫЛКА=0;"ZERO";СЖПРОБЕЛЫ(ВЫБОР((ОСТАТ(ССЫЛКА;1000000000)-ОСТАТ(ССЫЛКА;100000000))/100000000+1;"";"ONE HUNDRED";"TWO HUNDRED";"THREE HUNDRED";"FOUR HUNDRED";"FIVE HUNDRED";"SIX HUNDRED";"SEVEN HUNDRED";"EIGHT HUNDRED";"NINE HUNDRED") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(ССЫЛКА;100000000)<20000000;1;(ОСТАТ(ССЫЛКА;100000000)-ОСТАТ(ССЫЛКА;10000000))/10000000);"";"TWENTY";"THIRTY";"FORTY";"FIFTY";"SIXTY";"SEVENTY";"EIGHTY";"NINETY") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(ССЫЛКА;100000000)<19999999;ОСТАТ(ССЫЛКА;100000000);ОСТАТ(ССЫЛКА;10000000))-ОСТАТ(ССЫЛКА;1000000))/1000000+1;"";"ONE";"TWO";"THREE";"FOUR";"FIVE";"SIX";"SEVEN";"EIGHT";"NINE";"TEN";"ELEVEN";"TWELVE";"THIRTEEN";"FOURTEEN";"FIFTEEN";"SIXTEEN";"SEVENTEEN";"EIGHTEEN";"NINETEEN") & " " & ЕСЛИ(ССЫЛКА<1000000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(ССЫЛКА;100000000)<20000000;ОСТАТ(ССЫЛКА;100000000);ОСТАТ(ССЫЛКА;10000000))-ОСТАТ(ССЫЛКА;1000000))/1000000=1;"MILLION";ЕСЛИ(И((ЕСЛИ(ОСТАТ(ССЫЛКА;100000000)<20000000;ОСТАТ(ССЫЛКА;100000000);ОСТАТ(ССЫЛКА;10000000))-ОСТАТ(ССЫЛКА;1000000))/1000000>1;(ЕСЛИ(ОСТАТ(ССЫЛКА;100000000)<20000000;ОСТАТ(ССЫЛКА;100000000);ОСТАТ(ССЫЛКА;10000000))-ОСТАТ(ССЫЛКА;1000000))/1000000<5);"MILLION";"MILLION"))) & " " & ВЫБОР((ОСТАТ(ССЫЛКА;1000000)-ОСТАТ(ССЫЛКА;100000))/100000+1;"";"ONE HUNDRED";"TWO HUNDRED";"THREE HUNDRED";"FOUR HUNDRED";"FIVE HUNDRED";"SIX HUNDRED";"SEVEN HUNDRED";"EIGHT HUNDRED";"NINE HUNDRED") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(ССЫЛКА;100000)<20000;1;(ОСТАТ(ССЫЛКА;100000)-ОСТАТ(ССЫЛКА;10000))/10000);"";"TWENTY";"THIRTY";"FORTY";"FIFTY";"SIXTY";"SEVENTY";"EIGHTY";"NINETY") & " " & ВЫБОР((ЕСЛИ(ОСТАТ(ССЫЛКА;100000)<19999;ОСТАТ(ССЫЛКА;100000);ОСТАТ(ССЫЛКА;10000))-ОСТАТ(ССЫЛКА;1000))/1000+1;"";"ONE";"TWO";"THREE";"FOUR";"FIVE";"SIX";"SEVEN";"EIGHT";"NINE";"TEN";"ELEVEN";"TWELVE";"THIRTEEN";"FOURTEEN";"FIFTEEN";"SIXTEEN";"SEVENTEEN";"EIGHTEEN";"NINETEEN") & " " & ЕСЛИ(ССЫЛКА<1000;"";ЕСЛИ((ЕСЛИ(ОСТАТ(ССЫЛКА;100000)<20000;ОСТАТ(ССЫЛКА;100000);ОСТАТ(ССЫЛКА;10000))-ОСТАТ(ССЫЛКА;1000))/1000=1;"THOUSAND";ЕСЛИ(И((ЕСЛИ(ОСТАТ(ССЫЛКА;100000)<20000;ОСТАТ(ССЫЛКА;100000);ОСТАТ(ССЫЛКА;10000))-ОСТАТ(ССЫЛКА;1000))/1000>1;(ЕСЛИ(ОСТАТ(ССЫЛКА;100000)<20000;ОСТАТ(ССЫЛКА;100000);ОСТАТ(ССЫЛКА;10000))-ОСТАТ(ССЫЛКА;1000))/1000<5);"THOUSAND";"THOUSAND"))) & " " & ВЫБОР((ОСТАТ(ССЫЛКА;1000)-ОСТАТ(ССЫЛКА;100))/100+1;"";"ONE HUNDRED";"TWO HUNDRED";"THREE HUNDRED";"FOUR HUNDRED";"FIVE HUNDRED";"SIX HUNDRED";"SEVEN HUNDRED";"EIGHT HUNDRED";"NINE HUNDRED") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(ССЫЛКА;100)<20;1;(ОСТАТ(ССЫЛКА;100)-ОСТАТ(ССЫЛКА;10))/10);"";"TWENTY";"THIRTY";"FORTY";"FIFTY";"SIXTY";"SEVENTY";"EIGHTY";"NINETY") & " " & ВЫБОР(ЕСЛИ(ОСТАТ(ССЫЛКА;100)<20;ОСТАТ(ССЫЛКА;100);ОСТАТ(ССЫЛКА;10))+1;"";"ONE";"TWO";"THREE";"FOUR";"FIVE";"SIX";"SEVEN";"EIGHT";"NINE";"TEN";"ELEVEN";"TWELVE";"THIRTEEN";"FOURTEEN";"FIFTEEN";"SIXTEEN";"SEVENTEEN";"EIGHTEEN";"NINETEEN"))) & " METRIC TONS & " & ОСТАТ(ССЫЛКА*1000;1000) & " KILOGRAMS"
Слушайте, как круто, когда час когда то потраченного времени так помог людям. Есть еще формулы проверки ИНН(ЮЛ+ФЛ)/ОГРН/ОГРНИП/БИК/КОРсч/РАСсч - может тоже надо? Тоже без макросов... куда выложить скажите...
29.10.2016 10:07:00
Здравствуйте, Николай, Очень бы хотелось воспользоваться Вашей функцией сумма прописью, но у меня в xls 2003 добавив функцию она получается без аргументов. В чем дело? Подскажите, плиз, надо печатать кучу инвентаризационных ведомостей:cry:
10.11.2016 14:05:45
Добрый день!
очень хороший макрос!
но мне нужно чтоб он писал не целые числа (например: 10 целых 5 десятых)
поправила в 14 строке на If n < 1 Then...но все равно не работает....
подскажите пожалуйста как поправить  
02.12.2016 12:31:47
Подскажите, если получается целое число, т.е. после запятой "00" как добавить в формулу, чтоб прописью писало "00 коп."? Спасибо!
19.01.2017 15:19:55
Ребят все то хорошо как сделать что бы я сохранил модуль не только в этом документе но что бы он уже в экселе самом был да бы при открытии любого файла эксель там был задан этот модуль
16.02.2017 13:45:04
Самый простой вариант , это сохранить свой макрос в личной книге макросов (PERSONAL.XLSB) , тогда при открытии любой книги Excel, на твоем компе, макрос будет доступен.  
31.05.2017 16:42:48
Добрый день! А как сохранить в Личной книге Макросов?
23.02.2017 02:45:21
Доброго времени суток!
Вы такие молодцы! Столько полезных тем!
22.09.2017 16:16:31
Подскажите, пожалуйста, как функцию VBA, которая в шапке, заставить писать сумму прописью от 0 до 999 999 999 999,99?
тут встречал формулу, но файл постоянно ругается, что слишком длинная.
спасибо
18.05.2018 13:04:56
Скопировала все как у вас прописано, но когда ввожу формулу выходит ошибка Compile error^ Expected^ list separator or

Помоги разобраться
21.05.2018 09:13:56
Скачайте файл с примером из заголовка статьи и используйте рабочий код оттуда, если не получается скопировать с вебстраницы.
06.11.2018 00:41:03
Немного дополнил функцию для текстового представления сумм в рублях с учетом копеек (до 999 999 999 999,99).
Также встроена проверка округления исходного значения, чтобы функция всегда срабатывала корректно. Если значение не округлено, функция выведет сообщение вместо текстового представления.
При необходимости можно удалить добавление рублевого формата и изменить порядок расписывания дробной части, например, на "23/100", "233/1000" 2332/10000" и т.д.
Function СУММАПРОПИСЬЮ_(n As Double) As String
'проверка корректности округления исходного значения, для которого формируется текстовое представление
Otherside = InStr(1, n, ".")
If VBA.Len(n) - Otherside >= 3 And Otherside > 0 Then
MsgBox ("ОКРУГЛИТЕ ИСХОДНЫЕ ЗНАЧЕНИЯ")

'при прохождении проверки исходного значения применяется следующий код:
Else
    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)
        sotmil = Class(n, 9)
        bil = Class(n, 10)
        decbil = Class(n, 11)
        sotbil = Class(n, 12)
 
     'определяем сотни миллиардов
Billions:
     sotbil_txt = Nums3(sotbil)
     'проверяем миллиарды. если в числе есть десятки / сотни миллиардов, используется код ниже
     Select Case decbil
       'в случае если разряд "десятки миллиардов" равен одному, применяется массив Nums5 (десять - девятнадцать миллиардов).
       Case 1
         bil_txt = Nums5(bil) & "миллиардов "
         'в случае 1 работа с миллиардами завершена, поэтому переходим к миллионам
         GoTo Millions
       'в случае если разряд "десятки миллиардов" от 2 до 9, применяется массив Nums2 (двадцать - девяносто миллиардов)
       Case 2 To 9
          decbil_txt = Nums2(decbil)
     End Select
     Select Case bil
       Case 0
         If decbil > 0 Then bil_txt = Nums1(bil) & "миллиардов "
       Case 1
         bil_txt = Nums1(bil) & "миллиард "
       Case 2, 3, 4
         bil_txt = Nums1(bil) & "миллиарда "
       Case 5 To 9
         bil_txt = Nums1(bil) & "миллиардов "
     End Select

     'Если отсутствуют "десятки" / "единицы" миллиардов, используются сотни миллиардов
     If decbil = 0 And bil = 0 And sotbil <> 0 Then sotbil_txt = sotbil_txt & "миллиардов "
    
     'определяем сотни миллионов
Millions:
     sotmil_txt = Nums3(sotmil)
     'проверяем миллионы. если в числе есть десятки / сотни миллионов, используется код ниже
     Select Case decmil
       'в случае если разряд "десятки миллионов" равен одному, применяется массив Nums5 (десять - девятнадцать миллионов)
       Case 1
         mil_txt = Nums5(mil) & "миллионов "
         'в случае 1 работа с миллионами завершена, поэтому переходим к тысячам
         GoTo Thousands
       'в случае если разряд "десятки миллионов" от 2 до 9, применяется массив Nums2 (двадцать - девяносто миллионов)
       Case 2 To 9
         decmil_txt = Nums2(decmil)
     End Select
     Select Case mil
       Case 0
         If decmil > 0 Then mil_txt = Nums1(mil) & "миллионов "
       Case 1
          mil_txt = Nums1(mil) & "миллион "
       Case 2, 3, 4
         mil_txt = Nums1(mil) & "миллиона "
       Case 5 To 9
         mil_txt = Nums1(mil) & "миллионов "
     End Select
 
     'Если отсутствуют "десятки" / "единицы" миллионов, используются сотни миллионов
     If decmil = 0 And mil = 0 And sotmil <> 0 Then sotmil_txt = sotmil_txt & "миллионов "
 
     'определяем сотни тысяч
Thousands:
     sottys_txt = Nums3(sottys)
     'проверяем тысячи
     Select Case dectys
       'в случае если разряд "десятки тысяч" равен одному, применяется массив Nums5 (десять - девятнадцать тысяч)
       Case 1
         tys_txt = Nums5(tys) & "тысяч "
         'в случае 1 работа с тысячами завершена, поэтому переходим к единицам
         GoTo Units
       'в случае если разряд "десятки тысяч" от 2 до 9, применяется массив Nums2 (двадцать - девяносто тысяч)
       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 & " тысяч "
 
     'определяем сотни
Units:
     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:
    'формируем итоговую строку, которую будет выводить формула
    I_am_batman = sotbil_txt & decbil_txt & bil_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
    'Делаем первую букву в итоговой строке заглавной
    Joker = UCase(Left(I_am_batman, 1)) & Mid(I_am_batman, 2, Len(I_am_batman) - 1)

    'Ниже приведен расчет рублевого формата, принеобходимости можно удалить
    'Получив сумму прописью рассчитываем для нее рублевый формат с учетом падежей
    If Right(Int(n), 2) > 10 And Right(Int(n), 2) < 20 Then
    Trump = "рублей "
    Else
        If ed = 0 Then Trump = "рублей "
        If ed = 1 Then Trump = "рубль "
        If ed > 1 And ed <= 4 Then Trump = "рубля "
        If ed >= 5 And ed < 10 Then Trump = "рублей "
    End If
 
    'То же самое для копеек (знаков после запятой)
    '!ВНИМАНИЕ! если знаков после запятой больше 2 формула округляет
    'значение до 2 знаков и расписывает текстовое значение для него
    '! НУЖНО НЕ ЗАБЫТЬ ОКРУГЛИТЬ ИСХОДНОЕ ЗНАЧЕНИЕ (n), формула это не делает !
    Darth_Vader = Round(n - Int(n), 2) * 100
    If (Darth_Vader) > 10 And (Darth_Vader) < 20 Then
    Death_star = " копеек"
    Else
        If Right(Darth_Vader, 1) = 0 Then Death_star = " копеек"
        If Right(Darth_Vader, 1) = 1 Then Death_star = " копейка"
        If Right(Darth_Vader, 1) > 1 And Right(Darth_Vader, 1) <= 4 Then Death_star = " копейки"
        If Right(Darth_Vader, 1) >= 5 And Right(Darth_Vader, 1) < 10 Then Death_star = " копеек"
    End If
    
    'Добавляем ноль спереди для 1 - 9 копеек, чтобы получить 01, 02 ... 09 копеек
    If (Darth_Vader) >= 0 And (Darth_Vader) <= 9 Then
    Emperor = 0
    Else: Emperor = ""
    End If
     
    'Выводим итоговую формулу, склеивая все получившиеся значения
    СУММАПРОПИСЬЮ = Joker & Trump & Emperor & Darth_Vader & Death_star
End If
End Function
 
'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, i)
  Class = Int(Int(M - (10 ^ i) * Int(M / (10 ^ i))) / 10 ^ (i - 1))
End Function
18.01.2019 11:11:24
=СУММАПРОПИСЬЮ(AI)&"руб. "&ТЕКСТ((AI-ЦЕЛОЕ(AI))*100;"00")&" копеек"  
Какие изменения нужно внести в формулу, чтобы число целое было написано в скобках? Заранее спасибо за ответ
18.03.2019 15:15:30
Немного подредактировал код Panzer  от 06.11.2018 00:41:03

добавил строку
n = WorksheetFunction.Round(n, 2)

теперь округляет самостоятельно
и добавил условие при формировании суммы, теперь 0,11 пишет "Ноль рублей 11 копеек", раньше выдавал ошибку
ниже исправленный код:



 Function СУММАПРОПИСЬЮ(n As Double) As String
'проверка корректности округления исходного значения, для которого формируется текстовое представление
Otherside = InStr(1, n, ",")  ' точку заменил на запятую
'''''''''''''''''''''''''''''''''
n = WorksheetFunction.Round(n, 2) ' Добавленная строка, округляет значение
'''''''''''''''''''''''''''''''''
If VBA.Len(n) - Otherside >= 3 And Otherside > 0 Then
MsgBox ("ОКРУГЛИТЕ ИСХОДНЫЕ ЗНАЧЕНИЯ")


'при прохождении проверки исходного значения применяется следующий код:
Else
    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)
        sotmil = Class(n, 9)
        bil = Class(n, 10)
        decbil = Class(n, 11)
        sotbil = Class(n, 12)
 
     'определяем сотни миллиардов
Billions:
     sotbil_txt = Nums3(sotbil)
     'проверяем миллиарды. если в числе есть десятки / сотни миллиардов, используется код ниже
     Select Case decbil
       'в случае если разряд "десятки миллиардов" равен одному, применяется массив Nums5 (десять - девятнадцать миллиардов).
       Case 1
         bil_txt = Nums5(bil) & "миллиардов "
         'в случае 1 работа с миллиардами завершена, поэтому переходим к миллионам
         GoTo Millions
       'в случае если разряд "десятки миллиардов" от 2 до 9, применяется массив Nums2 (двадцать - девяносто миллиардов)
       Case 2 To 9
          decbil_txt = Nums2(decbil)
     End Select
     Select Case bil
       Case 0
         If decbil > 0 Then bil_txt = Nums1(bil) & "миллиардов "
       Case 1
         bil_txt = Nums1(bil) & "миллиард "
       Case 2, 3, 4
         bil_txt = Nums1(bil) & "миллиарда "
       Case 5 To 9
         bil_txt = Nums1(bil) & "миллиардов "
     End Select

     'Если отсутствуют "десятки" / "единицы" миллиардов, используются сотни миллиардов
     If decbil = 0 And bil = 0 And sotbil <> 0 Then sotbil_txt = sotbil_txt & "миллиардов "
    
     'определяем сотни миллионов
Millions:
     sotmil_txt = Nums3(sotmil)
     'проверяем миллионы. если в числе есть десятки / сотни миллионов, используется код ниже
     Select Case decmil
       'в случае если разряд "десятки миллионов" равен одному, применяется массив Nums5 (десять - девятнадцать миллионов)
       Case 1
         mil_txt = Nums5(mil) & "миллионов "
         'в случае 1 работа с миллионами завершена, поэтому переходим к тысячам
         GoTo Thousands
       'в случае если разряд "десятки миллионов" от 2 до 9, применяется массив Nums2 (двадцать - девяносто миллионов)
       Case 2 To 9
         decmil_txt = Nums2(decmil)
     End Select
     Select Case mil
       Case 0
         If decmil > 0 Then mil_txt = Nums1(mil) & "миллионов "
       Case 1
          mil_txt = Nums1(mil) & "миллион "
       Case 2, 3, 4
         mil_txt = Nums1(mil) & "миллиона "
       Case 5 To 9
         mil_txt = Nums1(mil) & "миллионов "
     End Select
 
     'Если отсутствуют "десятки" / "единицы" миллионов, используются сотни миллионов
     If decmil = 0 And mil = 0 And sotmil <> 0 Then sotmil_txt = sotmil_txt & "миллионов "
 
     'определяем сотни тысяч
Thousands:
     sottys_txt = Nums3(sottys)
     'проверяем тысячи
     Select Case dectys
       'в случае если разряд "десятки тысяч" равен одному, применяется массив Nums5 (десять - девятнадцать тысяч)
       Case 1
         tys_txt = Nums5(tys) & "тысяч "
         'в случае 1 работа с тысячами завершена, поэтому переходим к единицам
         GoTo Units
       'в случае если разряд "десятки тысяч" от 2 до 9, применяется массив Nums2 (двадцать - девяносто тысяч)
       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 & "тысяч "
 
     'определяем сотни
Units:
     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:
     
'''''''' Добавленное условие
    If sotbil_txt & decbil_txt & bil_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt = "" Then
        I_am_batman = "ноль "
    Else
    'формируем итоговую строку, которую будет выводить формула
        I_am_batman = sotbil_txt & decbil_txt & bil_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
    'Делаем первую букву в итоговой строке заглавной
    End If

    Joker = UCase(Left(I_am_batman, 1)) & Mid(I_am_batman, 2, Len(I_am_batman) - 1)

    'Ниже приведен расчет рублевого формата, при необходимости можно удалить
    'Получив сумму прописью рассчитываем для нее рублевый формат с учетом падежей
    If Right(Int(n), 2) > 10 And Right(Int(n), 2) < 20 Then
    Trump = "рублей "
    Else
        If ed = 0 Then Trump = "рублей "
        If ed = 1 Then Trump = "рубль "
        If ed > 1 And ed <= 4 Then Trump = "рубля "
        If ed >= 5 And ed < 10 Then Trump = "рублей "
    End If
 
    'То же самое для копеек (знаков после запятой)
    '!ВНИМАНИЕ! если знаков после запятой больше 2 формула округляет
    'значение до 2 знаков и расписывает текстовое значение для него
    '! НУЖНО НЕ ЗАБЫТЬ ОКРУГЛИТЬ ИСХОДНОЕ ЗНАЧЕНИЕ (n), формула это не делает !
    Darth_Vader = Round(n - Int(n), 2) * 100
    If (Darth_Vader) > 10 And (Darth_Vader) < 20 Then
    Death_star = " копеек"
    Else
        If Right(Darth_Vader, 1) = 0 Then Death_star = " копеек"
        If Right(Darth_Vader, 1) = 1 Then Death_star = " копейка"
        If Right(Darth_Vader, 1) > 1 And Right(Darth_Vader, 1) <= 4 Then Death_star = " копейки"
        If Right(Darth_Vader, 1) >= 5 And Right(Darth_Vader, 1) < 10 Then Death_star = " копеек"
    End If
    
    'Добавляем ноль спереди для 1 - 9 копеек, чтобы получить 01, 02 ... 09 копеек
    If (Darth_Vader) >= 0 And (Darth_Vader) <= 9 Then
    Emperor = 0
    Else: Emperor = ""
    End If
     
    'Выводим итоговую формулу, склеивая все получившиеся значения
    СУММАПРОПИСЬЮ = Joker & Trump & Emperor & Darth_Vader & Death_star
End If
End Function
 
'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, i)
  Class = Int(Int(M - (10 ^ i) * Int(M / (10 ^ i))) / 10 ^ (i - 1))
End Function
18.03.2019 15:36:30
извините за опечатку в строке в начале кода:
Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "ноль ")
нужно удалить - "ноль ".
В принципе не на, что не влияет, но лучше удалить.
Строка должна выглядеть:
Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
20.04.2019 22:45:23
Сергей Матвеев
18.03.2019 15:15:30
Спасибо то что надо.

Николай разместили бы  данную Версию, правда там Бетманы летают ))

и ребят Я  обычно всегда пишу  с Option Explicit, и что в оригинале и что в версии Сергея, пришлось регистрировать Бетменов,  Джокеров и иных персонажей
Наверх