Сумма прописью
Ниже вы найдете готовую пользовательскую функцию на 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 2007 или 2010, то тип файла должен быть с поддержкой макросов, т.е. в формате xlsm!) и вернитесь в Excel. Теперь вы можете вставить созданную функцию в любую ячейку листа этой книги обычным способом - через мастер функций (кнопка fx в строке формул, категория Определенные пользователем) или просто набрав ее в ячейке вручную и указав в качестве аргумента ячейку с суммой:
Если вам необходимо добавить к полученному тексту копейки, то можно воспользоваться чуть более сложной конструкцией:
=СУММАПРОПИСЬЮ(A3)&" руб. "&ТЕКСТ((A3-ЦЕЛОЕ(A3))*100;"00")&" коп."
=СУММАПРОПИСЬЮ(A3)&" руб. "&TEXT((A3-INT(A3))*100;"00")&" коп."
Тогда, например, для числа 35,15 результат функции будет выглядеть как "тридцать пять руб. 15 коп."
Ссылки по теме
- Более мощный вариант функции с рублями и копейками на русском/английском из надстройки PLEX
- Что такое макросы, куда вставлять код макроса, как их использовать
Мне эта функция очень понравилось, очень пригодилась для заполнения препроводительных сумок с денежной наличностью.
Я вижу что есть "", он слишком "крутой" для нас.
Можно ли текущий вариант добавить функционал, чтобы первое слово было с Заглавной буквы, например:
34 руб = "Тридацать четыре рубля"
1 456 789 = "Один миллион четыреста пятьдесят шесть рублей семьсот восемьдесят девять рублей"
Буду очень признателен за помощь, т.к. банк требует первое слово с заглавной буквы.
где А1 - ячейка с вашим текстом или функция вывода суммы прописью.
Заранее благодарю!
Мои действия:
1. Сначала в листе появляется результат макроса с маленькой буквы;
2. Надо написать в другой ячейке эту формулу;
3. Скопировать данные из ячейки с формулой на место где сначала был результат макроса.
Более простого пути нет, чтобы сразу на первом шаге в нужной ячейке появлялась сумма с Заглавной буквы?
=ПРОПИСН(ЛЕВСИМВ(А1))&ПСТР(А1;2;ДЛСТР(А1)-1)
,для того, чтобы сумма писалась с заглавной буквы???
Вы говорите, что в ячейку. Но в этой ячейке и так уже есть формула
=СУММАПРОПИСЬЮ(P31)&" руб. "&ТЕКСТ((P31-ЦЕЛОЕ(P31))*100;"00";)&" коп."
Ничего не понятно!
???
=ЕСЛИ(ОКРУГЛ(B6-ЦЕЛОЕ(B6);2)=1;СЦЕПИТЬ(СУММАПРОПИСЬЮ(B6+1);" руб. 00 коп.");
СУММАПРОПИСЬЮ(B6)&" руб. "&ТЕКСТ((B6-ЦЕЛОЕ(B6))*100;"00")&" коп.").
Функция Николая Павлова не совсем корректна:
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" - латинская
За разъяснения - спасибо: стало намного понятнее!
По-моему, в 14 строке нужно подправить (в случае, если число будет не целое):
If n < 1 Then
столько нового и полезного узнал!
p.s.: ждем уроков по макросам!
Если в ячейке стоит сумма 321 000 000,01 - то макрос пишет прописью (с учетом добавления формулы) "Двадцать один миллион руб. 01 коп."
Как исправить?
Моя вина.
Хотелось бы узнать, как сделать так, чтобы данная функция была доступна для всех книг EXCEL, а не только для той, в которой заводился макрос?
Воспользовалась функцией для разработки формы по просьбе бухгалтера. Бухгалтер - счастлив.
Заранее спасибо!
в Excel есть функция БАТТЕКСТ, которая выполняет аналогичные действия, что и СУММАПРОПИСЬЮ, но только не на русском языке.
в справке Excel написано, что это можно исправить через Панель управления в Windows в Языковых (Региональных) стандартах.
я это попытался сделать, везде выставил "Рус." и т.п., но тем не менее функция БАТТЕКСТ по русски писать не стала.
может кто-нибудь знает, как это можно исправить? подскажите, пожалуйста.
Спасибо!
Возникла проблема. При вставке кода макроса вместо русских букв знаки вопросов. Как это исправить?
Не полностью пишет целые суммы:
с неровными суммами всё в порядке, а вот с ровными не очень. Сумма больше 9999999...
=ЕСЛИ(A1<0;"Минус "&СуммаПрописью(A1);СуммаПрописью(A1))
Какие настройки нужно изменить, чтобы макрос работал, когда рубли от копеек отделяются "-" (как в платежке)
То есть как пример в ячейке сумма цифрами нужно прописать 260-01 (Если просто заменить ',' на '-' - макрос не работает
Подскажите, как сделать, что бы результат отображался в скобках?
250 (двести пятьдесят)
Если ваше число лежит в ячейке A1, то формула будет
=A1&" ("&СУММАПРОПИСЬЮ(A1)&")"А можно ли вместо английского или русского писать в VBA на армянском эти цифры? У меня вопросительные знаки вместо букв приводит.
Заранее спасибо!
Поскажите пожалуйста
почему у меня проблемы с шрифтами в модуле
например СУММАПРОПИСЬЮ ÑÓÌÌÀÏÐÎÏÈÑÜÞ
Подскажите, что нужно сделать, чтобы в "русском" экселе результат данной формулы выводился на английском языке?
В блокноте замените «Ссылка» на нужное...
Можно всегда подправить под себя.
Не требует макроса, спокойно работает в EXCEL 2007
У меня была проблема, пользователей было много, не у всех были разрешены макросы, поэтому надо было думать формулами - во и вышло.
Теперь макросы использую только тогда, когда формулами нереально добиться результата.
Хотелось бы чуть-чуть усовершенствовать, чтобы до 10 коп. показывало 00, 01, 02 и т.д. Возможно?
Заменила концовку формулы ОСТАТ(Ссылка*100;100) & " коп." --> ТЕКСТ((Ссылка-ЦЕЛОЕ(Ссылка)*100;"00") &" коп."
Пробовала макрос сделать, но, как и у некоторых, отображает кучу вопросительных знаков, кириллицу не воспринимает.
В любом случае, рада, что наткнулась на этот познавательный сайт
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)) & " коп."
Заменить часть формулы после "руб.".
Подскажите пожалуйста, как подправить Ваш макрос, чтобы числа были на английском, например: 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) & " коп."
А такую формулу подправлять желающих найдется немного
просто подправил под себя. не стал сокращать, хотя учитывая особенности формирования числительных в английском, точно можно сократить. может кто возьмется. а пока так.
=ЕСЛИ(ССЫЛКА=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"
очень хороший макрос!
но мне нужно чтоб он писал не целые числа (например: 10 целых 5 десятых)
поправила в 14 строке на If n < 1 Then...но все равно не работает....
подскажите пожалуйста как поправить
Вы такие молодцы! Столько полезных тем!
тут встречал формулу, но файл постоянно ругается, что слишком длинная.
спасибо
Помоги разобраться
Также встроена проверка округления исходного значения, чтобы функция всегда срабатывала корректно. Если значение не округлено, функция выведет сообщение вместо текстового представления.
При необходимости можно удалить добавление рублевого формата и изменить порядок расписывания дробной части, например, на "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Какие изменения нужно внести в формулу, чтобы число целое было написано в скобках? Заранее спасибо за ответ
добавил строку
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 FunctionNums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ", "ноль ")
нужно удалить - "ноль ".
В принципе не на, что не влияет, но лучше удалить.
Строка должна выглядеть:
Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
18.03.2019 15:15:30
Спасибо то что надо.
Николай разместили бы данную Версию, правда там Бетманы летают ))
и ребят Я обычно всегда пишу с Option Explicit, и что в оригинале и что в версии Сергея, пришлось регистрировать Бетменов, Джокеров и иных персонажей
строка:
'формируем итоговую строку, которую будет выводить формула
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
у меня записана так:
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)
соответственно изменил (у меня появилась скобка и пробел):
'Делаем третью букву в итоговой строке заглавной
End If
Joker = UCase(Left(I_am_batman, 3)) & Mid(I_am_batman, 4, Len(I_am_batman) - 1)
Получается формула (как пример):
=СЦЕПИТЬ(СМЕЩ(Приемка!$F$1;$A$1-1;14);" ";суммапрописью(СМЕЩ(Приемка!$F$1;$A$1-1;14)))
и в итоге сумма прописью:
123456 ( Сто двадцать три тысячи четыреста пятьдесят шесть ) рублей 78 копеек
Дополнительные пробелы мной сделаны для удобства читаемости документа, т.к. выводится полужирным курсивом.
Можно в формировании итоговой строки эти пробелы убрать, соответственно изменить номер буквы в формировании заглавной буквы.
Один вопрос к Андрею или другим компетентным в этих вопросах людям:
Когда я вставляю формулу типа: =СЦЕПИТЬ(ОТБР(75,86);" руб. ";ОКРУГЛ(ОСТАТ(75,86;ОТБР(75,86))*100;0);" коп."
то если у меня число с копейками до 10, например " 45,02 " , на выходе получается "45 руб. 2 коп." Если же копейки больше 10, то все хорошо. Как исправить формулу и сделать так. чтобы число 45,02 преобразовать в 45 руб. 02 коп.
Вместо 45,02 в формуле можно добавить ссылку на ячейку с числом
Спасибо Вам огромное. Все получилось.
Работаю в иностранной компании , здесь стоит офис 365, установили мне русский язык , вроде навигация вся на русском , но функция пропись на русском выводит непонятные символы , на англ работает как нужно. Может быть кто то сталкивался и не хватает какого то русского шрифта ?