На сайте gb.by в разделе «Файлы настройки форм», а так же у Агентства Гревцова в свободном доступе была экселевская надстройка (макрос) Деньги прописью.xla, Цифры прописью.xla, позволяющая с помощью встроенных функций переводить числовые/денежные значения в пропись. Поиски в сети так же не принесли результата — надстройки либо работают не корректно (не выводят копейки), либо не запускаются совсем. Поэтому было решено по действующим стандартам написать свою.
- Вариант №1 более надежный: за основу взят шаблон российского файла и переписан под валюты: евро, доллар США, белорусский рубль, российский рубль, казахстанский тенге, украинская гривна. Файл СуммаПрописью.xlam(.rar) протестирован несколько месяцев «в боевых условиях» офисными работниками и доступен для свободного скачивания.
- Вариант №2 более быстрый: на одном из форумов нашёл пример реализации данной функции с помощью формулы, то есть без применения макросов. Также дописал под вышеперечисленные валюты. Формула получается громоздкой, но если нет времени и желаний возится с встраиванием надстройки в Excel, то можно воспользоваться и таким способом.
* — устранение ошибки: архив поврежден или имеет неизвестный формат. иногда на данный макрос при распаковке архива возможны ложные срабатывания антивирусных программ, поэтому рекомендуется временно отключить защиту.
Установка
Запускаем Excel. Файл — Параметры — Надстройки.
Управление: Надстройки Excel — Перейти…
Кнопка «Обзор» — копируем скачанный и распакованный файл СуммаПрописью_1Cnik.by.xlam в папку «C:UsersUserAppDataRoamingMicrosoftAddIns» и выбираем его.
Надстройка «Сумма прописью» появляется в списке. Ставим галку.
На листе Excel вызываем необходимую функцию из категории: «Определенные пользователем» или прописываем в ячейке вручную с сылкой на числовое поле:
=СуммаПрописьюBYN(Nячейки) — функция возвращает сумму прописью в белорусских рублях BYN
=СуммаПрописьюEUR(Nячейки) — функция возвращает сумму прописью в евро EUR
=СуммаПрописьюRUB(Nячейки) — функция возвращает сумму прописью в российских рублях RUB
=СуммаПрописьюUSD(Nячейки) — функция возвращает сумму прописью в долларах USD
Обновление 08.2021 (добавлены новые валюты):
=СуммаПрописьюKZT(Nячейки) — функция возвращает сумму прописью в казахстанских тенге KZT
=СуммаПрописьюUAH(Nячейки) — функция возвращает сумму прописью в украинских гривнах UAH
Обновление 10.2021 (добавлены новые валюты):
=СуммаПрописьюBYN(Nячейки) — функция возвращает сумму прописью в белорусских рублях BYN — удалена лишняя запятая
=СуммаПрописьюRUBRB(Nячейки) — функция возвращает сумму прописью в российских рублях RUB — создан дополнительный спец.формат для выписки документов в РБ для РФ (вместо «рублей», возвращает «российских рублей»)
Получаем выбранную сумму прописью!
Если категория: «Определенные пользователем» не отображается, а функции недоступны. Скорее всего Excel заблокировал макрос. Для активации надстройки нужно отключить защищенный просмотр. Открываем Файл – Параметры – Центр управления безопасностью – кнопка «Параметры центра управления безопасностью…».
Вкладка «Защищенный просмотр» — снять все галки «Включить защищенный просмотр…». Проверяйте! Надстройка должна стать активной!
Состав архива:
-
Пример в Excel.xlsx
- SummaPropisjuBYN.txt — формула возвращает сумму прописью в белорусских рублях BYN
- SummaPropisjuEUR.txt — формула возвращает сумму прописью в евро EUR
- SummaPropisjuUSD.txt — формула возвращает сумму прописью в долларах USD
- SummaPropisjuKZT.txt — формула возвращает сумму прописью в казахстанских тенге KZT
- SummaPropisjuUAH.txt — формула возвращает сумму прописью в украинских гривнах UAH
- SummaPropisjuRUB.txt — формула возвращает сумму прописью в российских рублях RUB
- SummaPropisjuRUBRB.txt — формула возвращает сумму прописью в российских рублях RUB для выписки документов в РБ для РФ (вместо «рублей», возвращает «российских рублей»)
Плюс данного метода состоит в том, что настраивать ничего не надо. Достаточно скопировать формулу из нужного файла и вставить в ячейку, в которую нужно выводить денежную сумму прописью. Минусы метода: громоздкая формула и для изменения числовой ячейки (A1) каждый раз нужно менять всякое её упоминание во всей формуле (по умолчанию A1).
Примечание: если у Вас в Excel установлен разделитель целой и дробной части – ‘точка’. То для того чтобы формула корректно работала — нужно в формуле найти ТЕКСТ(A1;»0,00″) и заменить на ТЕКСТ(A1;»0.00″).
Вставка формулы в Excel
Открываем текстовый файл с формулой (например: SummaPropisjuRUB_1Cnik.by.txt) в блокноте.
В меню нажимаем: Правка -> Заменить (Ctrl+H). Например: нужная нам сумма (число) расположено на листе Excel в
ячейке A3. Следовательно заменяем все значения в формуле с A1 на A3
Вставляем формулу, например в ячейку A4 и нажимаем Ввод
В ячейке A4 получаем сумму прописью в нужной нам валюте
Copyright©, «Программист 1С в г.Минске», 09.12.2020 (upd. 26.08.2021)
Перепечатка текста и фотографий разрешена при наличии прямой ссылки на источник
Содержание
- Сумма прописью в excel
- Функция сумма прописью на русском языке
- Вставка суммы прописью через пользовательскую форму
- Подробный синтаксис функции
- Функция сумма прописью на украинском языке
- Функция сумма прописью на английском языке
- Число прописью в Excel: инструкция, как написать сумму
- Как в Excel сделать сумму прописью
- Формула суммы прописью в Excel — как написать число
- Преобразование с помощью макросов Excel
Сумма прописью в excel
Функция сумма прописью на русском языке
После установки надстройки VBA-Excel добавится функционал для вставки суммы прописью. Он содержит удобную форму для ввода (см. рисунок справа), а также функцию СУММАПРОПИСЬЮ, которой можно пользоваться так же как и любой встроенной в Excel.
Вы сможете указать число прописью в любом падеже, а также выбрать формат вывода, который необходим в конкретном случае.
Вы можете указать сумму прописью в договоре в рублях (как с копейками так и без), в долларах США или евро (с центами или без). Помимо суммы договора можно прописывать прописью и срок в календарных или рабочих днях. Можно указывать количество товара прописью в штуках.
Функционал достаточно гибкий и позволяет настраивать отображение скобок, формат дробной части, указывать сумму с заглавной или прописной буквы и многое другое.
Вставка суммы прописью через пользовательскую форму
Наиболее простой способ вставить сумму прописью — это заполнить специальную форму.
- Выберите ячейку, в которую необходимо вставить число прописью.
- На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Русский.
- Появится диалоговое окно для выбора параметров функции. Заполните ее так как необходимо Вам. Настройки автоматически сохраняются, чтобы не пришлось повторять действия в следующий раз.
- Нажмите Вставить текстом, тогда сумма прописью будет вставлена в ячейку как текст. Нажмите Вставить формулой в случае если в ячейку должна быть вставлена формула, в этом случае сумма прописью будет автоматически изменяться при редактировании числа.
Второй способ вставить сумму прописью — это ввести формулу в ячейку: =СУММАПРОПИСЬЮ(A1), где A1 — ссылка на ячейку с формулой.
Далее рассмотрим подробнее синтаксис функции.
Подробный синтаксис функции
Для использования функции не обязательно постоянно вызывать форму с параметрами. Функцию можно использовать также как и прочие функции Excel. Функция имеет следующие переменные:
=СУММАПРОПИСЬЮ(Число; [Падеж]; [Тип_данных] ; [Дробь_прописью] ; [Дублировать_число] ; [Скобки] ; [Заглавная] )
Квадратные скобки означают что переменная не обязательная, в этом случае используется значение по умолчанию.
- Число — ссылка на ячейку или число (не обязательно в числовом формате), которое необходимо написать прописью.
- [Падеж] — число от 1 до 6, определяющее падеж
- Именительный (по умолчанию если параметр не указан)
- Родительный
- Дательный
- Винительный
- Творительный
- Предложный
- [Тип_данных] — число от 0 до 8 для добавления после суммы прописью в нужном падеже тип данных
- Ничего (по умолчанию если параметр не указан)
- Рубли
- Доллары США
- Евро
- Календарные дни
- Рабочие дни
- Дни
- Штуки
- Целое + дробная часть
- [Дробь_прописью] — значение 0 или 1, которое указывает на необходимость записи дробной части числа прописью
- Не выводить прописью дробную часть числа (по умолчанию)
- Указать прописью также и дробную часть числа
- [Дублировать_число] — значение 0 или 1, которое указывает на необходимость дублирования числа перед суммой прописью
- Скрыть число перед суммой прописью
- Продублировать числовое значение суммы прописью (по умолчанию)
- [Скобки] — значение 0 или 1, которое указывает на необходимость записывать сумму прописью в скобках
- Убрать скобки из суммы прописью
- Поместить сумму прописью в скобки (по умолчанию)
- [Заглавная] — значение 0 или 1, которое указывает на необходимость делать первую букву суммы прописью заглавной
- Все буквы суммы прописью строчные
- Сделать первую букву заглавной (по умолчанию)
Разберем синтаксис функции на примерах:
Склонение числительных по падежам.
Добавление типа данных после указания суммы прописью. Обратите внимание, что если вторая переменная (падеж) не задана, то указывается по умолчанию в именительном падеже.
Как прописать дробную часть числа с помощью функции.
Различные форматы вывода суммы прописью.
Функция сумма прописью на украинском языке
Аналогичный функционал для вставки суммы прописью есть и для украинского языка. Также имеется похожая форма для удобной вставки и функция СУММАПРОПИСЬЮУКР.
Чтобы вызвать форму для вставки суммы прописью на украинском языке, выполните следующие действия:
- Выберите ячейку, в которую необходимо вставить число прописью.
- На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Украинский.
- Дальнейшие действия аналогичны
Функция сумма прописью на английском языке
Функция сумма прописью на английском языке несколько проще чем описанные выше. Тут нет падежей и формат прописи всегда один.
Чтобы вставить число прописью на английском языке нужно:
- Выбрать ячейку в которую необходимо вставить результат
- На вкладке VBA-Excel нажмите команду Сумма прописью и выберите язык Английский.
- Укажите число и нажмите одну из кнопок Вставить формулой или Вставить текстом.
Вместо формы ввода, Вы также можете пользоваться функцией =СУММАПРОПИСЬЮEN(ЧИСЛО). Функция имеет один аргумент: ЧИСЛО — значение или ссылка на ячейку с числом, которое необходимо преобразовать в текст прописью.
Источник
Число прописью в Excel: инструкция, как написать сумму
Во многих документах мы можем видеть строку, в которой требуется указать сумму не в числовом виде, а прописью. Это защищает отчетность от подделки, ведь цифру легко переправить. А вот длинную запись незаметно исправить не так-то просто. Сумма прописью в Excel доступна только в виде надстроек или с использованием формул. Встроенного инструмента не имеется.
Как в Excel сделать сумму прописью
Чтобы получить эту возможность, вы можете скачать надстройку «Сумма прописью» в Excel бесплатно на нашем сайте.
Разместите его в любом удобном каталоге и подключите. Для этого следует пройти следующие этапы:
Эта функция «сумма_прописью» работает в Excel 2007, 2010, 2016
Данная надстройка работает только для рублей. Если вам нужна другая валюта, скачайте еще файл sumprop.xla. Действуя по аналогии подключите надстройку для получения суммы прописью в Excel.
Для проверки введем в ячейке A3 произвольное число. Пусть это будет десятичная дробь. Также вызовем окно вставки функций и найдем новые функции для вывода суммы прописью.
Как видите, нам стали доступны:
- Сумма Прописью
- Сумма Прописью Доллары
- Сумма Прописью Евро
- Сумма Прописью Евро
Переведем число в евро. Выбираем соответствующую функцию и кликаем по ячейке с числом.
После нажатия ОК получаем результат.
С помощью этих инструментов преобразование числа в текст прописью в Excel выполняется очень просто. Если по каким-то причинам вы не хотите устанавливать их в Excel, можно воспользоваться другим способом.
Формула суммы прописью в Excel — как написать число
Для вывода числа прописью в Excel можно создать формулу. Приведем пример:
Для ее использования вам необходимо указать несколько массивов Excel:
Просто скопируйте эту таблицу на лист Excel, а формулу вставляйте туда, где необходима сумма прописью. Вышеприведенная конструкция предназначена для ячейки A3. Не забудьте поменять адрес.
В англоязычном Excel формула суммы прописью будет выглядеть следующим образом:
SUBSTITUTE(PROPER(INDEX(n_4,MID(TEXT(A1,n0),1,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),2,1)+1,MID(TEXT(A1,n0),3,1)+1)&IF(-MID(TEXT(A1,n0),1,3),»миллиард»&VLOOKUP(MID(TEXT(A1,n0),3,1)*AND(MID(TEXT(A1,n0),2,1)-1),мил,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),4,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),5,1)+1,MID(TEXT(A1,n0),6,1)+1)&IF(-MID(TEXT(A1,n0),4,3),»миллион»&VLOOKUP(MID(TEXT(A1,n0),6,1)*AND(MID(TEXT(A1,n0),5,1)-1),мил,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),7,1)+1)&INDEX(n1x,MID(TEXT(A1,n0),8,1)+1,MID(TEXT(A1,n0),9,1)+1)&IF(-MID(TEXT(A1,n0),7,3),VLOOKUP(MID(TEXT(A1,n0),9,1)*AND(MID(TEXT(A1,n0),8,1)-1),тыс,2),»»)&INDEX(n_4,MID(TEXT(A1,n0),10,1)+1)&INDEX(n0x,MID(TEXT(A1,n0),11,1)+1,MID(TEXT(A1,n0),12,1)+1)),»z»,» «)&IF(TRUNC(TEXT(A1,n0)),»»,»Ноль «)&»рубл»&VLOOKUP(MOD(MAX(MOD(MID(TEXT(A1,n0),11,2)-11,100),9),10),<0,»ь «;1,»я «;4,»ей «>,2)&RIGHT(TEXT(A1,n0),2)&» копе»&VLOOKUP(MOD(MAX(MOD(RIGHT(TEXT(A1,n0),2)-11,100),9),10),<0,»йка»;1,»йки»;4,»ек»>,2)
Как видим, это не самый удобный способ преобразовать число в текст прописью в Excel.
Преобразование с помощью макросов Excel
Можно написать собственную функцию, которая произведет конвертацию суммы прописью. Нажмите сочетание ALT+F11 и в открывшемся разработчике Excel VBA вставьте новый модуль.
В него добавьте следующий код.
Теперь эту функцию можно вызвать обычным путем и получить сумму прописью. Она находится в разделе функций Excel «Определенные пользователем».
В качестве аргумента укажите адрес с числом.
Перевод в сумму прописью осуществляется только для целых чисел.
Дробное число требует дополнительной формулы:
Вместо ячейки A7 подставляйте свой адрес. Копейки в таком исполнении будут выводиться в виде числа.
Мы рассмотрели все способы представления суммы прописью в Excel. Выбирайте для себя самый удобный и пользуйтесь с удовольствием!
Источник
Универсальная функция для вывода суммы прописью для чисел от 0 до 99 999 999 на русском или английском языке для заданной валюты (рубли, доллары, евро).
Синтаксис
=Propis(Amount; Money; Lang; Prec)
где
- Amount — ячейка с суммой, которую надо представить прописью
- Money — код валюты (RUB, EUR, USD)
- Lang — на каком языке вывести сумму (RU или EN)
- Prec — надо (1) или нет (0) выводит дробную часть числа, т.е. копейки или центы.
Полный список всех инструментов надстройки PLEX
20.04.2017 08:34:46
Добрый день!
есть ли возможность вывести сумму на украинском языке?
22.04.2017 10:18:13
23.04.2017 00:12:20
было под носом и не увидел 
Спасибо!
20.05.2017 13:15:42
Формула вида =Propis(Почта!$Q$2;RUB;RU;0) не работает выдается ошибка…это вставлена через мастер формул в надстройке…работает только =Propis(Q2)
26.10.2017 08:36:27
«RUB» и «RU» должны быть в кавычках — это же текстовые строки, они в любой функции и формуле должны быть заключены в кавычки.
24.08.2018 14:00:51
Николай, это PLEX так ставит
23.08.2017 15:30:06
Добрый день, в данном выше примере функция работает как мне необходимо, но в скачанной версии от мая 2017 понимает только =PropisRus(A2;1) такой вариант, а мне нужно чтобы выводилось полное название копеек рублей и после запятой выводилось 00 копеек а не 0 копеек. Это можно исправить?
26.10.2017 08:42:05
Используйте функцию =Propis(A2) вместо PropisRus.
13.09.2017 02:39:08
А если мне просто число написать нужно, или в конце добавить шткгтоннящиковбанок и т.д.? типа 12,5- двенадцать целых пять десятых или 3шт- три шт?
26.10.2017 08:39:05
Для целых чисел можно использовать функцию PropisRus без дополнительных аргументов и приклеить к ней нужные единицы измерения, т.е. =PropisRus(A1)&» шт.»
25.10.2017 12:17:03
Будьте добры, подскажите, какую формулу можно использовать, чтобы сумму писало прописью русским текстом, а денежную единицу выдавало в укр.валюте (гривне), копейки тоже нужны.
Функция =PropisUkr(N; Hryvnias; Kopecks) работает отлично, но текст только на украинском языке.
26.10.2017 08:35:22
Такого нет. Есть Propis на русском-английском, которая умеет выводить рубли, доллары, евро. И есть PropisUkr, которая выводит гривны на украинском. Если нужна функция-мутант, то придется либо писать свою, либо ждать, когда я добавлю гривны в Propis 
26.10.2017 09:50:57
Благодарю за ответ. Все функции Propis уже обошла вдоль и поперёк.
Значит, придётся к макросу обращаться. Но мутация — это хорошо:D Спасибо!
22.03.2018 10:27:30
Добрый день! а если нужно чтобы при использовании функции Propis текст выводился не в рублях а в кг?
20.07.2018 10:34:30
Нужно лезть в исходный код функции на VBA и заменить там везде рубли на «кг».
Либо использовать функцию PropisRus для вывода числа без единиц измерения и приклеить потом к результату «кг»:
17.07.2018 23:37:47
Доброго времени суток! Есть ли возможность вывода на немецком языке суммы прописью? Заранее спасибо за ответ!
20.07.2018 10:31:50
Ну, готовой функции у меня для немецкого языка нет, к сожалению.
11.12.2019 17:57:19
Николай, добрый день!
Обнаружил, чо данная функция некорректно работает со значениями начиная от 10 000 000 000.
Например:
| 10 000 000 000,00 | #ЗНАЧ! |
| 10 000 000 010,00 | Десять рублей 00 копеек |
| 15 000 000 000,00 | Пять миллиардов рублей 00 копеек |
Спасибо.
Алексей
13.12.2019 21:32:11
А первую строчку статьи прочитать?
16.12.2019 10:36:06
Да, действительно, написано. Прошу извинить.
Я давно работаю с этой функцией, по этому подсознательно думал, что все про нее знаю.
К сожалению (или к счастью) приходится работать с большими суммами. Жаль, что функция не работает с ними.
20.12.2019 12:55:52
Добрый день! Пожалуйста, добавьте к функцию сумма прописью национальную валюту Узбекистана — сум и тийин, а также возможность загрузки курсы валют Центрального банка Узбекистана. Спасибо.
21.08.2020 17:01:59
Добрый день. Можно сделать что бы скобки были после слова рубль, а копейки были после скобок?
Цена контракта составляет: 10 500 (Десять тысяч пятьсот рублей) 00 копеек
30.10.2020 18:13:14
Добрый день! Функция PropisRus не работает, пишет #ЗНАЧ. Хотя при выборе аргументов показывает верное значение, но как только нажимаешь ок, то в ячейке высвечивается ошибка. Подскажите что делать?
04.11.2020 17:20:00
Вы бы хоть описали, что именно делаете или скриншот приложили. Как я догадаюсь, в чем проблема?
05.11.2020 11:39:36
Вроде заработало. Открыл отдельный лист в ексель, попробовал и функция заработала. Значит это у меня в другой книге проблемы.
11.02.2021 17:12:27
Добрый день! Николай, отличная надстройка, купил с удовольствием. Но есть одно маленькое но, так как живу в Казахстане очень нужен вывод прописью тенге.
03.08.2021 14:26:39
Добрый день! Если копейки равны 00 или их нет то прописью выводит, если есть копейки то выдает ошибку. Как это исправить.
10.03.2022 11:18:06
Добрый день! Подскажите пожалуйста по этой функции планируется доработка на тенге_тиын. Или может она уже есть. П
опробовала на всякий случай =propiskz ничего не получилось)))
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379 380 381 382 383 384 385 386 387 388 389 390 391 392 393 394 395 396 397 |
Public Function Число_в_текст(ByVal SumBase As Double, ByVal Valuta As String) As String 'Переводит цифровое значение в текстовое предложение. 'Параметр Valuta: ' "руб" - рубли, ' "дол" - доллары, ' "евр" - евро, ' "грив"- гривны, ' "крон"- кроны, ' "" - без наименования, ' прочие текстовые наименования валют используются без склонения. ' Копейки и центы добавляются, если сотые значения присутствуют. '00 копеек добавляется, если есть дробная чаcть равная или более 0,001 Dim Edinicy(0 To 19) As String Dim Desyatki(0 To 9) As String Dim Sotni(0 To 9) As String Dim mlrd(0 To 9) As String Dim mln(0 To 9) As String Dim tys(0 To 9) As String Dim SumInt, x, shag, vl As Integer Dim txt, Sclon_Tys As String Dim Naim_Valuta_1 As String, Naim_Valuta_2 As String, Naim_Valuta_5 As String Dim Naim_Sotye_1 As String, Naim_Sotye_2 As String, Naim_Sotye_5 As String Dim Sotye As Integer, StrSotye As String Dim PereKluch As String '--------------------------------------------- Application.Volatile '--------------------------------------------- Edinicy(0) = "" Edinicy(1) = "один " Edinicy(2) = "два " Edinicy(3) = "три " Edinicy(4) = "четыре " Edinicy(5) = "пять " Edinicy(6) = "шесть " Edinicy(7) = "семь " Edinicy(8) = "восемь " Edinicy(9) = "девять " Edinicy(11) = "одиннадцать " Edinicy(12) = "двенадцать " Edinicy(13) = "тринадцать " Edinicy(14) = "четырнадцать " Edinicy(15) = "пятнадцать " Edinicy(16) = "шестнадцать " Edinicy(17) = "семнадцать " Edinicy(18) = "восемнадцать " Edinicy(19) = "девятнадцать " '--------------------------------------------- Desyatki(0) = "" Desyatki(1) = "десять " Desyatki(2) = "двадцать " Desyatki(3) = "тридцать " Desyatki(4) = "сорок " Desyatki(5) = "пятьдесят " Desyatki(6) = "шестьдесят " Desyatki(7) = "семьдесят " Desyatki(8) = "восемьдесят " Desyatki(9) = "девяносто " '--------------------------------------------- Sotni(0) = "" Sotni(1) = "сто " Sotni(2) = "двести " Sotni(3) = "триста " Sotni(4) = "четыреста " Sotni(5) = "пятьсот " Sotni(6) = "шестьсот " Sotni(7) = "семьсот " Sotni(8) = "восемьсот " Sotni(9) = "девятьсот " '--------------------------------------------- mlrd(0) = "миллиардов " mlrd(1) = "миллиард " mlrd(2) = "миллиарда " mlrd(3) = "миллиарда " mlrd(4) = "миллиарда " mlrd(5) = "миллиардов " mlrd(6) = "миллиардов " mlrd(7) = "миллиардов " mlrd(8) = "миллиардов " mlrd(9) = "миллиардов " '--------------------------------------------- mln(0) = "миллионов " mln(1) = "миллион " mln(2) = "миллиона " mln(3) = "миллиона " mln(4) = "миллиона " mln(5) = "миллионов " mln(6) = "миллионов " mln(7) = "миллионов " mln(8) = "миллионов " mln(9) = "миллионов " '--------------------------------------------- tys(0) = "тысяч " tys(1) = "тысяча " tys(2) = "тысячи " tys(3) = "тысячи " tys(4) = "тысячи " tys(5) = "тысяч " tys(6) = "тысяч " tys(7) = "тысяч " tys(8) = "тысяч " tys(9) = "тысяч " '--------------------------------------------- On Local Error Resume Next shag = 0 SumInt = Int(SumBase) For x = Len(SumInt) To 1 Step -1 shag = shag + 1 Select Case x Case 12 ' - сотни миллиардов vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 11 ' - десятки миллиардов vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 10 ' - единицы миллиардов vl = Mid(SumInt, shag, 1) If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллиардов " Else txt = txt & Edinicy(vl) & mlrd(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады Else txt = txt & Edinicy(vl) & mlrd(vl) End If '-КОНЕЦ БЛОКА_______________________ Case 9 ' - сотни миллионов vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 8 ' - десятки миллионов vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 7 ' - единицы миллионов vl = Mid(SumInt, shag, 1) If shag > 2 Then If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX End If If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) & "миллионов " Else: txt = txt & Edinicy(vl) & mln(vl) 'числа в диапозоне от 11 до 19 склоняются на "миллиардов" независимо от последнего числа триады Else txt = txt & Edinicy(vl) & mln(vl) End If '-КОНЕЦ БЛОКА_______________________ Case 6 ' - сотни тысяч vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 5 ' - десятки тысяч vl = Mid(SumInt, shag, 1) If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 4 ' - единицы тысяч vl = Mid(SumInt, shag, 1) If shag > 2 Then If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX End If Sclon_Tys = Edinicy(vl) & tys(vl) ' - вводим переменную Sclon_Tys из-за иного склонения тысяч в русском языке If vl = 1 Then Sclon_Tys = "одна " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys ) If vl = 2 Then Sclon_Tys = "две " & tys(vl) ' - для тысяч склонение "один" и "два" неприменимо ( поэтому вводим переменную Sclon_Tys ) If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag - 1, 2)) & "тысяч " End If txt = txt & Sclon_Tys '-КОНЕЦ БЛОКА_______________________ Case 3 ' - сотни vl = Mid(SumInt, shag, 1) txt = txt & Sotni(vl) Case 2 ' - десятки vl = Mid(SumInt, shag, 1) If vl = "1" And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo LblNextX Else txt = txt & Desyatki(vl) ' - если конец триады от 11 до 19 то перескакиваем на единицы, иначе - формируем десятки Case 1 ' - единицы vl = Mid(SumInt, shag, 1) If shag > 2 Then If (Mid(SumInt, shag - 2, 1) = 0 And Mid(SumInt, shag - 1, 1) = 0 And vl = "0") Then GoTo LblNextX End If If shag > 1 Then If Mid(SumInt, shag - 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag - 1, 2)) Else: txt = txt & Edinicy(vl) Else txt = txt & Edinicy(vl) End If '-КОНЕЦ БЛОКА_______________________ End Select LblNextX: Next x If InStr(1, LCase(Valuta), "руб") > 0 Then Valuta = "рубли" If InStr(1, LCase(Valuta), "дол") > 0 Then Valuta = "доллары" If InStr(1, LCase(Valuta), "евр") > 0 Then Valuta = "евро" If InStr(1, LCase(Valuta), "грив") > 0 Then Valuta = "гривны" If InStr(1, LCase(Valuta), "крон") > 0 Then Valuta = "кроны" Select Case Valuta Case "рубли" Naim_Valuta_1 = "рубль" Naim_Valuta_2 = "рубля" Naim_Valuta_5 = "рублей" Naim_Sotye_1 = "копейка" Naim_Sotye_2 = "копейки" Naim_Sotye_5 = "копеек" Case "доллары" Naim_Valuta_1 = "доллар" Naim_Valuta_2 = "доллара" Naim_Valuta_5 = "долларов" Naim_Sotye_1 = "цент" Naim_Sotye_2 = "цента" Naim_Sotye_5 = "центов" Case "евро" Naim_Valuta_1 = "евро" Naim_Valuta_2 = "евро" Naim_Valuta_5 = "евро" Naim_Sotye_1 = "цент" Naim_Sotye_2 = "цента" Naim_Sotye_5 = "центов" Case "гривны" Naim_Valuta_1 = "гривна" Naim_Valuta_2 = "гривны" Naim_Valuta_5 = "гривен" Naim_Sotye_1 = "копейка" Naim_Sotye_2 = "копейки" Naim_Sotye_5 = "копеек" Case "крон" Naim_Valuta_1 = "крона" Naim_Valuta_2 = "кроны" Naim_Valuta_5 = "крон" Naim_Sotye_1 = "геллер" Naim_Sotye_2 = "геллера" Naim_Sotye_5 = "геллеров" Case "" Naim_Valuta_1 = "" Naim_Valuta_2 = "" Naim_Valuta_5 = "" Naim_Sotye_1 = "" Naim_Sotye_2 = "" Naim_Sotye_5 = "" Case Else Naim_Valuta_1 = Valuta Naim_Valuta_2 = Valuta Naim_Valuta_5 = Valuta Naim_Sotye_1 = "сотая" Naim_Sotye_2 = "сотых" Naim_Sotye_5 = "сотых" End Select If shag = 1 Then shag = 2 If vl = 0 Or vl > 4 Or (Mid(SumInt, shag - 1, 2) > 10 And Mid(SumInt, shag - 1, 2) < 20) Then txt = txt + Naim_Valuta_5 Else If vl = 1 Then txt = txt + Naim_Valuta_1 Else txt = txt + Naim_Valuta_2 End If Sotye = CInt((SumBase - SumInt) * 100) StrSotye = Format(Sotye, "00") If CInt((SumBase - SumInt) * 1000) > 0 Then txt = txt & " " & StrSotye & " " Select Case Left(StrSotye, 1) Case "0", "2", "3", "4", "5", "6", "7", "8", "9" PereKluch = Right(StrSotye, 1) Case Else PereKluch = StrSotye End Select Select Case PereKluch Case "1" txt = txt & Naim_Sotye_1 Case "2", "3", "4" txt = txt & Naim_Sotye_2 Case Else txt = txt & Naim_Sotye_5 End Select End If Число_в_текст = UCase(Left(txt, 1)) & Right(txt, Len(txt) - 1) End Function Public Function Число_в_текст_руб_коп(Сумма As Currency) As String 'до 999 999 999 999.99 On Local Error GoTo RUB_Error Dim strРубли As String, strКопейки As String, StrTemp As String Dim strМиллиарды As String, strМиллионы As String, strТысячи As String, strЕдиницы As String, strСотые As String Dim Поз As Integer '--------------------------------------------- Application.Volatile '--------------------------------------------- strРубли = Format(Int(Сумма), "000000000000") strКопейки = Format(Int((Сумма - Int(Сумма)) * 100), "00") 'Миллиарды' Поз = 1 strМиллиарды = Сотни(Mid(strРубли, Поз, 1)) strМиллиарды = strМиллиарды & Десятки(Mid(strРубли, Поз + 1, 2), "м") strМиллиарды = strМиллиарды & ИмяРазряда(strМиллиарды, Mid(strРубли, Поз + 1, 2), "миллиард ", "миллиарда ", "миллиардов ") 'Миллионы' Поз = 4 strМиллионы = Сотни(Mid(strРубли, Поз, 1)) strМиллионы = strМиллионы & Десятки(Mid(strРубли, Поз + 1, 2), "м") strМиллионы = strМиллионы & ИмяРазряда(strМиллионы, Mid(strРубли, Поз + 1, 2), "миллион ", "миллиона ", "миллионов ") 'Тысячи' Поз = 7 strТысячи = Сотни(Mid(strРубли, Поз, 1)) strТысячи = strТысячи & Десятки(Mid(strРубли, Поз + 1, 2), "ж") strТысячи = strТысячи & ИмяРазряда(strТысячи, Mid(strРубли, Поз + 1, 2), "тысяча ", "тысячи ", "тысяч ") 'Единицы' Поз = 10 strЕдиницы = Сотни(Mid(strРубли, Поз, 1)) strЕдиницы = strЕдиницы & Десятки(Mid(strРубли, Поз + 1, 2), "м") If strМиллиарды & strМиллионы & strТысячи & strЕдиницы = "" Then strЕдиницы = "ноль " strЕдиницы = strЕдиницы & ИмяРазряда(" ", Mid(strРубли, Поз + 1, 2), "рубль ", "рубля ", "рублей ") 'Сотые' strСотые = strКопейки & " " & ИмяРазряда(strКопейки, Right(strКопейки, 2), "копейка", "копейки", "копеек") StrTemp = strМиллиарды & strМиллионы & strТысячи & strЕдиницы & strСотые Число_в_текст_руб_коп = UCase(Left(StrTemp, 1)) & Right(StrTemp, Len(StrTemp) - 1) Exit Function RUB_Error: MsgBox Err.Description End Function Private Function Сотни(n As String) As String Сотни = "" Select Case n Case 0: Сотни = "" Case 1: Сотни = "сто " Case 2: Сотни = "двести " Case 3: Сотни = "триста " Case 4: Сотни = "четыреста " Case 5: Сотни = "пятьсот " Case 6: Сотни = "шестьсот " Case 7: Сотни = "семьсот " Case 8: Сотни = "восемьсот " Case 9: Сотни = "девятьсот " End Select End Function Private Function Десятки(n As String, Sex As String) As String Десятки = "" Select Case Left(n, 1) Case "0": Десятки = "": n = Right(n, 1) Case "1": Десятки = "" Case "2": Десятки = "двадцать ": n = Right(n, 1) Case "3": Десятки = "тридцать ": n = Right(n, 1) Case "4": Десятки = "сорок ": n = Right(n, 1) Case "5": Десятки = "пятьдесят ": n = Right(n, 1) Case "6": Десятки = "шестьдесят ": n = Right(n, 1) Case "7": Десятки = "семьдесят ": n = Right(n, 1) Case "8": Десятки = "восемьдесят ": n = Right(n, 1) Case "9": Десятки = "девяносто ": n = Right(n, 1) End Select Dim Двадцатка As String Двадцатка = "" Select Case n Case "0": Двадцатка = "" Case "1" Select Case Sex Case "м": Двадцатка = "один " Case "ж": Двадцатка = "одна " Case "с": Двадцатка = "одно " End Select Case "2": Select Case Sex Case "м": Двадцатка = "два " Case "ж": Двадцатка = "две " Case "с": Двадцатка = "два " End Select Case "3": Двадцатка = "три " Case "4": Двадцатка = "четыре " Case "5": Двадцатка = "пять " Case "6": Двадцатка = "шесть " Case "7": Двадцатка = "семь " Case "8": Двадцатка = "восемь " Case "9": Двадцатка = "девять " Case "10": Двадцатка = "десять " Case "11": Двадцатка = "одиннадцать " Case "12": Двадцатка = "двенадцать " Case "13": Двадцатка = "тринадцать " Case "14": Двадцатка = "четырнадцать " Case "15": Двадцатка = "пятнадцать " Case "16": Двадцатка = "шестнадцать " Case "17": Двадцатка = "семнадцать " Case "18": Двадцатка = "восемнадцать " Case "19": Двадцатка = "девятнадцать " End Select Десятки = Десятки & Двадцатка End Function Private Function ИмяРазряда(Строка As String, n As String, Имя1 As String, Имя24 As String, ИмяПроч As String) As String If Строка <> "" Then ИмяРазряда = "" Select Case Left(n, 1) Case "0", "2", "3", "4", "5", "6", "7", "8", "9": n = Right(n, 1) End Select Select Case n Case "1": ИмяРазряда = Имя1 Case "2", "3", "4": ИмяРазряда = Имя24 Case Else: ИмяРазряда = ИмяПроч End Select End If End Function |
Часто нужно перевести число в текст в Excel так, чтобы оно отображалось прописью (словами) на русском или других языках. Так как по умолчанию нет готовой функции, создадим свою пользовательскую функцию с помощью макросов.
Пример использования пользовательской функции для преобразования числа суммы в текстовые слова, которую можно скачать в конце статьи:
Для создания пользовательской функции, которая сможет перевести число в текст прописью , нам нужно выполнить 3 простых шага:
- Открыть редактор макросов ALT+F11.
- Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».
- Вставить в модуль следующий код и сохранить:
Function ЧислоПропись(Число As Currency) As String
‘до 999 999 999 999
On Error GoTo Число_Error
Dim strМиллиарды As String, strМиллионы As String, strТысячи As String, strЕдиницы As String, strСотые As String
Dim Поз As Integer
strЧисло = Format(Int(Число),
«000000000000»)
‘Миллиарды’
Поз = 1
strМиллиарды = Сотни(Mid(strЧисло, Поз, 1))
strМиллиарды = strМиллиарды & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллиарды = strМиллиарды & ИмяРазряда(strМиллиарды, Mid(strЧисло, Поз + 1, 2), «миллиард «, «миллиарда «, «миллиардов «)
‘Миллионы’
Поз = 4
strМиллионы = Сотни(Mid(strЧисло, Поз, 1))
strМиллионы = strМиллионы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
strМиллионы = strМиллионы & ИмяРазряда(strМиллионы, Mid(strЧисло, Поз + 1, 2), «миллион «, «миллиона «, «миллионов «)
‘Тысячи’
Поз = 7
strТысячи = Сотни(Mid(strЧисло, Поз, 1))
strТысячи = strТысячи & Десятки(Mid(strЧисло, Поз + 1, 2), «ж»)
strТысячи = strТысячи & ИмяРазряда(strТысячи, Mid(strЧисло, Поз + 1, 2), «тысяча «, «тысячи «, «тысяч «)
‘Единицы’
Поз = 10
strЕдиницы = Сотни(Mid(strЧисло, Поз, 1))
strЕдиницы = strЕдиницы & Десятки(Mid(strЧисло, Поз + 1, 2), «м»)
If strМиллиарды & strМиллионы & strТысячи & strЕдиницы = «» Then strЕдиницы = «ноль «
‘strЕдиницы = strЕдиницы & ИмяРазряда(» «, Mid(strЧисло, Поз + 1, 2), «рубль «, «рубля «, «рублей «)
‘Сотые’
‘strСотые = strКопейки & » » & ИмяРазряда(strКопейки, Right(strКопейки, 2), ‘»копейка», «копейки», «копеек»)
ЧислоПропись = strМиллиарды & strМиллионы & strТысячи & strЕдиницы
ЧислоПропись = UCase(Left(ЧислоПропись, 1)) & Right(ЧислоПропись, Len(ЧислоПропись) — 1)
Exit Function
Число_Error:
MsgBox Err.Description
End Function
Function Сотни(n As String) As String
Сотни = «»
Select Case n
Case 0: Сотни = «»
Case 1: Сотни = «сто «
Case 2: Сотни = «двести «
Case 3: Сотни = «триста «
Case 4: Сотни = «четыреста «
Case 5: Сотни = «пятьсот «
Case 6: Сотни = «шестьсот «
Case 7: Сотни = «семьсот «
Case 8: Сотни = «восемьсот «
Case 9: Сотни = «девятьсот «
End Select
End Function
Function Десятки(n As String, Sex As String) As String
Десятки = «»
Select Case Left(n, 1)
Case «0»: Десятки = «»: n = Right(n, 1)
Case «1»: Десятки = «»
Case «2»: Десятки = «двадцать «: n = Right(n, 1)
Case «3»: Десятки = «тридцать «: n = Right(n, 1)
Case «4»: Десятки = «сорок «: n = Right(n, 1)
Case «5»: Десятки = «пятьдесят «: n = Right(n, 1)
Case «6»: Десятки = «шестьдесят «: n = Right(n, 1)
Case «7»: Десятки = «семьдесят «: n = Right(n, 1)
Case «8»: Десятки = «восемьдесят «: n = Right(n, 1)
Case «9»: Десятки = «девяносто «: n = Right(n, 1)
End Select
Dim Двадцатка As String
Двадцатка = «»
Select Case n
Case «0»: Двадцатка = «»
Case «1»
Select Case Sex
Case «м»: Двадцатка = «один «
Case «ж»: Двадцатка = «одна «
Case «с»: Двадцатка = «одно «
End Select
Case «2»:
Select Case Sex
Case «м»: Двадцатка = «два «
Case «ж»: Двадцатка = «две «
Case «с»: Двадцатка = «два «
End Select
Case «3»: Двадцатка = «три «
Case «4»: Двадцатка = «четыре «
Case «5»: Двадцатка = «пять «
Case «6»: Двадцатка = «шесть «
Case «7»: Двадцатка = «семь «
Case «8»: Двадцатка = «восемь «
Case «9»: Двадцатка = «девять «
Case «10»: Двадцатка = «десять «
Case «11»: Двадцатка = «одиннадцать «
Case «12»: Двадцатка = «двенадцать «
Case «13»: Двадцатка = «тринадцать «
Case «14»: Двадцатка = «четырнадцать «
Case «15»: Двадцатка = «пятнадцать «
Case «16»: Двадцатка = «шестнадцать «
Case «17»: Двадцатка = «семнадцать «
Case «18»: Двадцатка = «восемнадцать «
Case «19»: Двадцатка = «девятнадцать «
End Select
Десятки = Десятки & Двадцатка
End Function
Function ИмяРазряда(Строка As String, n As String, Имя1 As String, Имя24 As String, ИмяПроч As String) As String
If Строка <> «» Then
ИмяРазряда = «»
Select Case Left(n, 1)
Case «0», «2», «3», «4», «5», «6», «7», «8», «9»: n = Right(n, 1)
End Select
Select Case n
Case «1»: ИмяРазряда = Имя1
Case «2», «3», «4»: ИмяРазряда = Имя24
Case Else: ИмяРазряда = ИмяПроч
End Select
End If
End Function
Можно написать алгоритм макро программы по-другому и еще сделать так, чтобы она дописывала валюту суммы прописью. Для этого создайте Module2 и введите в него следующий код:
Function ЧислоПрописьюВалюта(Число As Double, Optional Валюта As Integer = 1, Optional Копейки As Integer = 1)
Attribute ЧислоПрописьюВалюта.VB_Description = «Функция преобразовывает число суммы текстовыми словами»
Attribute ЧислоПрописьюВалюта.VB_ProcData.VB_Invoke_Func = » n1″
Dim Edinicy(0 To 19) As String: Dim EdinicyPoslednie(0 To 19) As String
Dim Desyatki(0 To 9) As String: Dim Sotni(0 To 9) As String: Dim mlrd(0 To 9) As String
Dim mln(0 To 9) As String: Dim tys(0 To 9) As String
Dim SumInt, x, shag, vl As Integer: Dim txt, Sclon_Tys As String
‘———————————————
Application.Volatile
‘———————————————
Edinicy(0) = «»: EdinicyPoslednie(0) = IIf(Валюта = 0, «евро», IIf(Валюта = 1, «рублей», «долларов»))
Edinicy(1) = «один «: EdinicyPoslednie(1) = IIf(Валюта = 0, «один евро», IIf(Валюта = 1, «один рубль», «один доллар»))
Edinicy(2) = «два «: EdinicyPoslednie(2) = IIf(Валюта = 0, «два евро», IIf(Валюта = 1, «два рубля», «два доллара»))
Edinicy(3) = «три «: EdinicyPoslednie(3) = IIf(Валюта = 0, «три евро», IIf(Валюта = 1, «три рубля», «три доллара»))
Edinicy(4) = «четыре «: EdinicyPoslednie(4) = IIf(Валюта = 0, «четыре евро», IIf(Валюта = 1, «четыре рубля», «четыре доллара»))
Edinicy(5) = «пять «: EdinicyPoslednie(5) = IIf(Валюта = 0, «пять евро», IIf(Валюта = 1, «пять рублей», «пять долларов»))
Edinicy(6) = «шесть «: EdinicyPoslednie(6) = IIf(Валюта = 0, «шесть евро», IIf(Валюта = 1, «шесть рублей», «шесть долларов»))
Edinicy(7) = «семь «: EdinicyPoslednie(7) = IIf(Валюта = 0, «семь евро», IIf(Валюта = 1, «семь рублей», «семь долларов»))
Edinicy(8) = «восемь «: EdinicyPoslednie(8) = IIf(Валюта = 0, «восемь евро», IIf(Валюта = 1, «восемь рублей», «восемь долларов»))
Edinicy(9) = «девять «: EdinicyPoslednie(9) = IIf(Валюта = 0, «девять евро», IIf(Валюта = 1, «девять рублей», «девять долларов»))
Edinicy(11) = «одиннадцать «: EdinicyPoslednie(11) = IIf(Валюта = 0, «одиннадцать евро», IIf(Валюта = 1, «одиннадцать рублей», «одиннадцать долларов»))
Edinicy(12) = «надцать «: EdinicyPoslednie(12) = IIf(Валюта = 0, «надцать евро», IIf(Валюта = 1, «надцать рублей», «надцать долларов»))
Edinicy(13) = «тринадцать «: EdinicyPoslednie(13) = IIf(Валюта = 0, «тринадцать евро», IIf(Валюта = 1, «тринадцать рублей», «тринадцать долларов»))
Edinicy(14) = «четырнадцать «: EdinicyPoslednie(14) = IIf(Валюта = 0, «четырнадцать евро», IIf(Валюта = 1, «четырнадцать рублей», «четырнадцать долларов»))
Edinicy(15) = «пятнадцать «: EdinicyPoslednie(15) = IIf(Валюта = 0, «пятнадцать евро», IIf(Валюта = 1, «пятнадцать рублей», «пятнадцать долларов»))
Edinicy(16) = «шестнадцать «: EdinicyPoslednie(16) = IIf(Валюта = 0, «шестнадцать евро», IIf(Валюта = 1, «шестнадцать рублей», «шестнадцать долларов»))
Edinicy(17) = «семнадцать «: EdinicyPoslednie(17) = IIf(Валюта = 0, «семнадцать евро», IIf(Валюта = 1, «семнадцать рублей», «семнадцать долларов»))
Edinicy(18) = «восемнадцать «: EdinicyPoslednie(18) = IIf(Валюта = 0, «восемнадцать евро», IIf(Валюта = 1, «восемнадцать рублей», «восемнадцать долларов»))
Edinicy(19) = «девятнадцать «: EdinicyPoslednie(19) = IIf(Валюта = 0, «девятнадцать евро», IIf(Валюта = 1, «девятнадцать рублей», «девятнадцать долларов»))
»———————————————
Desyatki(0) = «»: Sotni(0) = «»: tys(0) = «тисячь «: mln(0) = «миллионов «: mlrd(0) = «миллиардов «
Desyatki(1) = «десять «: Sotni(1) = «сто «: tys(1) = «тысяча «: mln(1) = «миллион «: mlrd(1) = «миллиарда «
Desyatki(2) = «двадцать «: Sotni(2) = «двести «: tys(2) = «тысячи «: mln(2) = «миллиона «: mlrd(2) = «миллиарда «
Desyatki(3) = «тридцать «: Sotni(3) = «триста «: tys(3) = «тысячи «: mln(3) = «миллиона «: mlrd(3) = «миллиарда «
Desyatki(4) = «сорок «: Sotni(4) = «четыреста «: tys(4) = «тысячи «: mln(4) = «миллиона «: mlrd(4) = «миллиарда «
Desyatki(5) = «пятьдесят «: Sotni(5) = «пятьсот «: tys(5) = «тысяч «: mln(5) = «миллионов «: mlrd(5) = «миллиардов «
Desyatki(6) = «шестьдесят «: Sotni(6) = «шестьсот «: tys(6) = «тысяч «: mln(6) = «миллионов «: mlrd(6) = «миллиардов «
Desyatki(7) = «семьдесят «: Sotni(7) = «семьсот «: tys(7) = «тысяч «: mln(7) = «миллионов «: mlrd(7) = «миллиардов «
Desyatki(8) = «восемьдесят «: Sotni(8) = «восемьсот «: tys(8) = «тысяч «: mln(8) = «миллионов «: mlrd(8) = «миллиардов «
Desyatki(9) = «девяносто «: Sotni(9) = «девятьсот «: tys(9) = «тысяч «: mln(9) = «миллионов «: mlrd(9) = «миллиардов «
‘———————————————
On Error Resume Next
SumInt = Int(Число)
For x = Len(SumInt) To 1 Step -1
shag = shag + 1
Select Case x
Case 12 ‘ — сотни миллиардов
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 11 ‘ — десятки миллиардов
vl = Mid(SumInt, shag, 1)
If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
Case 10 ‘ — единицы миллиардов
vl = Mid(SumInt, shag, 1)
If shag > 1 Then
If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиарда « Else txt = txt & Edinicy(vl) & mlrd(vl) ‘числа в диапозоне от 11 до 19 склоняются на «мільярдов» независимо от последнего числа триады
Else
txt = txt & Edinicy(vl) & mlrd(vl)
End If
‘-КОНЕЦ БЛОКА_______________________
Case 9 ‘ — сотни миллионов
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 8 ‘ — десятки миллионов
vl = Mid(SumInt, shag, 1)
If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
Case 7 ‘ — единицы миллионов
vl = Mid(SumInt, shag, 1)
If shag > 2 Then
If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
End If
If shag > 1 Then
If Mid(SumInt, shag — 1, 1) = 1 Then txt = txt & Edinicy(Mid(SumInt, shag — 1, 2)) & «миллиона « Else: txt = txt & Edinicy(vl) & mln(vl) ‘числа в диапозоне от 11 до 19 склоняются на «миллиардов» независимо от последнего числа триады
Else
txt = txt & Edinicy(vl) & mln(vl)
End If
‘-КОНЕЦ БЛОКА_______________________
Case 6 ‘ — сотни тысяч
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 5 ‘ — десятки тысяч
vl = Mid(SumInt, shag, 1)
If vl = 1 And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
Case 4 ‘ — единицы тысяч
vl = Mid(SumInt, shag, 1)
If shag > 2 Then
If (Mid(SumInt, shag — 2, 1) = 0 And Mid(SumInt, shag — 1, 1) = 0 And vl = «0») Then GoTo 10
End If
Sclon_Tys = Edinicy(vl) & tys(vl) ‘ — вводим переменную Sclon_Tys из-за иного склонения тысяч в русском языке
If vl = 1 Then Sclon_Tys = «одна « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную Sclon_Tys )
If vl = 2 Then Sclon_Tys = «две « & tys(vl) ‘ — для тысяч склонение «один» и «два» неприменимо ( поэтому вводим переменную Sclon_Tys )
If shag > 1 Then
If Mid(SumInt, shag — 1, 1) = 1 Then Sclon_Tys = Edinicy(Mid(SumInt, shag — 1, 2)) & «тисяч «
End If
txt = txt & Sclon_Tys
‘-КОНЕЦ БЛОКА_______________________
Case 3 ‘ — сотни
vl = Mid(SumInt, shag, 1)
txt = txt & Sotni(vl)
Case 2 ‘ — десятки
vl = Mid(SumInt, shag, 1)
If vl = «1» And Mid(SumInt, shag + 1, 1) <> 0 Then GoTo 10 Else txt = txt & Desyatki(vl) ‘ — если конец триады от 11 до 19 то перескакиваем на единицы, иначе — формируем десятки
Case 1 ‘ — единицы
If Mid(SumInt, shag — 1, 1) <> 1 Or Mid(SumInt, shag — 1, 2) = «10» Then vl = Mid(SumInt, shag, 1) Else vl = Mid(SumInt, shag — 1, 2)
txt = txt & EdinicyPoslednie(vl)
‘-КОНЕЦ БЛОКА_______________________
End Select
10: Next x
a = Число
b = Int(a)
c = (Round(a — b, 2)) * 100
If c < 10 And c >= 1 Then c = «0» + CStr(c)
If c = 0 Then c = CStr(c) + «0»
d = «»
If Валюта = 1 Then d = «коп.» Else d = «цен.»
If Валюта > 2 Or Валюта < 0 Then MsgBox «Укажите параметр 0-2»
If Валюта > 2 Or Валюта < 0 Then GoTo 11
If Копейки = 0 Then
d = «»
c = «»
End If
If Копейки = 2 Then d = «»
If Копейки > 2 Or Копейи < 0 Then MsgBox «Укажите параметр 0, 1 или 2»
If Копейки > 2 Or Копейки < 0 Then GoTo 11
ЧислоПрописьюВалюта = UCase(Left(txt, 1)) & LCase(Mid(txt, 2)) + » « + CStr(c) + d
11:
End Function
Sub DescribeFunction()
Dim FuncName As String
Dim FuncDesc As String
Dim Category As String
Dim ArgDesc(1 To 3) As String
FuncName =
«ЧислоПрописьюВалюта»
FuncDesc = «Функция преобразовывает число суммы текстовыми словами»
Category = 1 ‘Text category
ArgDesc(1) = «Исходная сумма»
ArgDesc(2) = «(необязательный) Тип отображаемой валюты 0-Евро, 1-Рубли, 2-Доллары.»
ArgDesc(3) = «(необязательный) Нужны ли копейки: 0-нет, 1-отображать копейи стандартно, 2-отображать только дробную часть (без слов).»
Application.MacroOptions _
Macro:=FuncName, _
Description:=FuncDesc, _
Category:=Category, _
ArgumentDescriptions:=ArgDesc
End Sub
Также не забудьте добавить в рабочую книгу код вызова макроса регистрации DescribeFunction, чтобы отображать описание атрибутов для пользовательской функции:
Private Sub Workbook_Open()
DescribeFunction
End Sub
Кроме того благодаря данному макросу DescribeFunction функция будет доступна в группе: «ФОРМУЛЫ»-«Библиотека функций»-«Финансовые»-«ЧислоПрописьюВалюта»
Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:
- 1-рубли;
- 2-доллары;
- 0-евро;
Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).
Скачать число прописью в Excel руб RUB.
Украинская версия функции ЧислоСловоВалюта для перевода сумм в гривны находиться в следующем файле:
Скачать функцию ЧислоСловоВалюта ГРН UAH
Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.