Как число сделать прописью в excel?
Содержание
При заполнении различных финансовых документов часто требуется прописать сумму не только числом, но и прописью. Конечно, это занимает гораздо больше времени, чем обычное написание с помощью цифр. Если подобным образом нужно заполнить не одно, а много документов, то временные потери становятся огромными. Кроме того, именно в записи суммы прописью наиболее часто встречаются грамматические ошибки. Давайте выясним, как сделать так, чтобы числа прописью вносились автоматически.
Использование надстройки
В Эксель нет встроенного инструмента, который бы помогал автоматически переводить цифры в слова. Поэтому для решения поставленной задачи используют специальные надстройки.
Одной из самых удобных является надстройка NUM2TEXT. Она позволяет поменять цифры на буквы через Мастер функций.
- Открываем программу Excel и переходим во вкладку «Файл».
- Перемещаемся в раздел «Параметры».
- В активном окне параметров переходим в раздел «Надстройки».
- Далее, в параметре настроек «Управление» устанавливаем значение «Надстройки Excel». Жмем на кнопку «Перейти…».
- Открывается небольшое окно надстроек Excel. Жмем на кнопку «Обзор…».
- В открывшемся окне ищем предварительно скачанный и сохраненный на жесткий диск компьютера файл надстройки NUM2TEXT.xla. Выделяем его и жмем на кнопку «OK».
- Мы видим, что данный элемент появился среди доступных надстроек. Ставим галочку около пункта NUM2TEXT и жмем на кнопку «OK».
- Для того, чтобы проверить как работает только что установленная надстройка пишем в любой свободной ячейке листа произвольное число. Выделяем любую другую ячейку. Кликаем по значку «Вставить функцию». Он расположен слева от строки формул.
- Запускается Мастер функций. В полном алфавитном перечне функций ищем запись «Сумма_прописью». Её раньше не было, но она появилась тут после установки надстройки. Выделяем эту функцию. Жмем на кнопку «OK».
- Отрывается окно аргументов функции Сумма_прописью. Оно содержит только одно поле «Сумма». Сюда можно записать обычное число. Оно в выделенной ячейке отобразиться в формате записанной прописью денежной суммы в рублях и копейках.
- После этого, любое число, которое записано в ячейку, указанную вами, будет отображаться в денежном виде прописью в том месте, где установлена формула функции.
Функцию можно также записать и вручную без вызова мастера функций. Она имеет синтаксис Сумма_прописью(сумма) или Сумма_прописью(координаты_ячейки). Таким образом, если вы в ячейке запишите формулу =Сумма_прописью(5)
, то после нажатия кнопки ENTER в этой ячейке отобразиться надпись «Пять рублей 00 копеек».
Если вы введете в ячейку формулу =Сумма_прописью(A2)
, то в таком случае, любое число, внесенное в ячейку A2 будет отображаться тут денежной суммой прописью.
Как видим, несмотря на то, что в Excel нет встроенного инструмента для преобразования чисел в сумму прописью, эту возможность можно довольно легко получить, просто установив необходимую надстройку в программу.
Мы рады, что смогли помочь Вам в решении проблемы.
Задайте свой вопрос в комментариях, подробно расписав суть проблемы. Наши специалисты постараются ответить максимально быстро.
Помогла ли вам эта статья?
Да Нет
Как правило, в финансовых документах довольно часто указывают сумму не только в виде числа, но и прописью. Вручную это делать сложно и долго. Гораздо проще автоматически преобразовать все значения при помощи функций. В данной статье мы рассмотрим, как в Excel сделать сумму прописью.
Для начала нужно открыть Эксель и написать какое-нибудь число.
Для того чтобы его перевести в текстовый вид, нужно скачать дополнительный макрос, написанный на vba. Данная функция по умолчанию в редакторе отсутствует.
Num2Text
Прежде чем приступить к дальнейшим действиям, вам необходимо скачать данную надстройку. Официального сайта в этом случае нет. Таких модулей в интернете довольно много.
Будьте внимательны. Скачивайте только те файлы, у которых расширение xla, а не exe, поскольку во втором случае там могут быть вирусы.
После этого нужно сделать следующее:
- Зайдите в пункт меню «Файл».
- В появившемся окне перейдите в раздел «Параметры».
- Затем нажимаем на пункт «Надстройки».
- Кликните на кнопку «Перейти» (предварительно убедитесь, что рядом выбран пункт «Надстройки Excel»).
- После этого у вас появится окно, в котором можно вставить дополнительные файлы, чтобы редактор «узнал» новые функции. Нажмите на кнопку «Обзор».
- После этого укажите заранее скаченный файл и кликните «Открыть».
- Затем нужно поставить галочку около нового пункта и нажать на «ОК».
На этом этап подготовки завершен. Теперь Excel сможет делать перевод цифр в текстовый вид.
Создание простой формулы
Для того чтобы увидеть возможности новых функций, нужно сделать следующее:
- Перейдите на любую соседнюю ячейку. Кликните на иконку «Fx».
- В появившемся окне в разделе категории выберите пункт «Полный алфавитный перечень».
- Найдите там функцию «Сумма_прописью». Выберите её и нажмите на «OK».
- После этого появится окно, в котором нужно указать аргументы функции. Следует указать ячейку, значение которой должно писаться прописью. Для этого достаточно кликнуть на неё.
- Сразу после этого адрес ячейки подставится автоматически. Для продолжения кликните «OK».
- В результате этого вы увидите вашу сумму прописью. Вплоть до копеек. Благодаря этому можно переводить даже дробные числа.
- Попробуйте изменить ваше значение на любое другое. Сумма прописью изменится мгновенно.
Сумма ячеек
В финансовых отчетах необходимо считать сумму различных ячеек или столбцов. В этом случае формула немного усложняется. Рассмотрим, как это сделать.
- Проставьте цифры в 4 ячейки подряд.
- Кликните на ячейку, в которой вы работали до этого. Скопируйте формулу при помощи сочетания клавиш Ctrl+C.
- После этого перейдите в другую ячейку, чтобы создать новую формулу. Активируйте строку ввода уравнений.
- Нажмите на клавиатуре на кнопки Ctrl+V.
- Удаляем аргумент функции, то есть «C4» в нашем случае. Вместо этого в скобке пишем обычную формулу суммы, которая будет считать диапазон наших ячеек.
=Сумма_прописью(СУММ(A4:D4))
- В результате этого должно получиться следующее.
- Нажмите на клавиатуре на кнопку Enter. В итоге вы увидите, что сумма указанного диапазона значений отобразилась прописью.
У данного модуля есть большой минус – вы сможете работать только с российкими рублями. То есть, не получится сделать сумму прописью для узбекских сумов, украинских гривен, казахских тенге, американских долларов, белорусских рублей, английских фунтов и так далее. Язык поменять не выйдет. Для таких случаев существует альтернативный метод.
Sumprop
Установка данного модуля происходит точно так же, как в описанном выше способе, только на этот раз выбираем другой файл.
Ставим галочку возле новой надстройки и нажимаем на кнопку «OK».
После этого в вашем редакторе появится еще несколько новых функций. Рассмотрим их всех.
Работа с формулами
Для этого нужно сделать следующие действия.
- Первым делом создадим наглядную таблицу. В одном столбце у нас будут цифры, во втором – результат. Для демонстрации возможностей будем использовать дробные числа.
- Переходим первую пустую ячейку и нажимаем на кнопку «Fx».
В появившемся окне выберите категорию «Определенные пользователем». Новые функции будут именно там.
Будем вставлять поочередно. Именно в той хронологии, как они идут в списке.
СуммаПрописью
- Выберите соответствующий пункт и нажмите на кнопку «OK».
Справка нам подсказывает, что эта функция для рублей.
- В появившемся окне нужно вставить аргумент. Для этого достаточно кликнуть на ячейку с числом.
- Благодаря этому адрес подставится автоматически. Для продолжения нажмите на кнопку «OK».
- В результате этого вы увидите следующее.
СуммаПрописьюГривны
- Выделяем следующую строчку и кликаем на иконку вставки функции.
- На этот раз выбираем вторую функцию. Для вставки нажимаем на кнопку «OK».
- Затем кликаем на следующее число.
- После автоматической подстановки нажмите на кнопку «OK».
- Результат будет следующим.
СуммаПрописьюДоллары
- Переходим на третью строчку и кликаем на иконку «Fx».
- Выбираем «долларовую» функцию и нажимаем на «OK».
- Указываем соответствующий аргумент.
- Кликаем на «OK».
- Благодаря этому целое число отображается в долларах, а дробное – в центах.
СуммаПрописьюЕвро
- Переходим на четвертую строчку и вызываем окно вставки уравнения.
- Указываем функцию для «Евро».
- Кликаем на соответствующий аргумент.
- Нажимаем на кнопку «OK».
- Результат будет следующим.
Обратите внимание на то, что количество центов (копеек) выводится всегда. Даже если их 0.
ЧислоПрописью
Преимущество данного модуля в том, что вы можете осуществить преобразование без дополнительных денежных приставок.
- Перейдите на последнюю строчку и нажмите на иконку «Fx».
- Выберите последнюю функцию.
- В качестве аргумента укажите последнее оставшееся число.
- Для вставки нажмите на кнопку «OK».
В результате проделанных действий, мы увидим следующую таблицу.
Обратите внимание на то, что во всех ячейках сумма прописью указывается с большой буквы и только число – с маленькой.
Платные модули
Описанные выше надстройки были бесплатными. В интернете можно найти и более мощные инструменты, но за определенную плату.
На сайте PlanetaExcel продается надстройка PLEX.
Нам показывают, что в ней находится огромная библиотека формул.
На момент публикации статьи стоимость надстройки оценивается в 795 рублей.
Разумеется, они предоставляют возможность бесплатного тестирования, но количество запусков ограничено.
Заключение
Прочитав данную инструкцию, вы должны были понять, как настроить редактор Excel, чтобы можно был выводить сумму прописью. Если у вас что-то не получается, возможны следующие варианты:
- вы скачали не тот файл;
- вы не добавили эту надстройку в Эксель;
- вы выделяете не те ячейки;
- используете не те функции;
- допускаете опечатку при подсчете суммы различных значений.
Видеоинструкция
Если у вас остались какие-нибудь вопросы или вы так и не смогли найти причину своих проблем, рекомендуется посмотреть видеоролик, в котором приводятся дополнительные комментарии к описанным выше инструкциям.
Часто нужно перевести число в текст в 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 ЧислоПрописьюВалюта(SumBase As Double, Valuta As Integer) 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(Valuta = 0, "евро", IIf(Valuta = 1, "рублей", "долларов")) Edinicy(1) = "один ": EdinicyPoslednie(1) = IIf(Valuta = 0, "один евро", IIf(Valuta = 1, "один рубль", "один доллар")) Edinicy(2) = "два ": EdinicyPoslednie(2) = IIf(Valuta = 0, "два евро", IIf(Valuta = 1, "два рубля", "два доллара")) Edinicy(3) = "три ": EdinicyPoslednie(3) = IIf(Valuta = 0, "три евро", IIf(Valuta = 1, "три рубля", "три доллара")) Edinicy(4) = "четыре ": EdinicyPoslednie(4) = IIf(Valuta = 0, "четыре евро", IIf(Valuta = 1, "четыре рубля", "четыре доллара")) Edinicy(5) = "пять ": EdinicyPoslednie(5) = IIf(Valuta = 0, "пять евро", IIf(Valuta = 1, "пять рублей", "пять долларов")) Edinicy(6) = "шесть ": EdinicyPoslednie(6) = IIf(Valuta = 0, "шесть евро", IIf(Valuta = 1, "шесть рублей", "шесть долларов")) Edinicy(7) = "семь ": EdinicyPoslednie(7) = IIf(Valuta = 0, "семь евро", IIf(Valuta = 1, "семь рублей", "семь долларов")) Edinicy(8) = "восемь ": EdinicyPoslednie(8) = IIf(Valuta = 0, "восемь евро", IIf(Valuta = 1, "восемь рублей", "восемь долларов")) Edinicy(9) = "девять ": EdinicyPoslednie(9) = IIf(Valuta = 0, "девять евро", IIf(Valuta = 1, "девять рублей", "девять долларов")) Edinicy(11) = "одиннадцать ": EdinicyPoslednie(11) = IIf(Valuta = 0, "одиннадцать евро", IIf(Valuta = 1, "одиннадцать рублей", "одиннадцать долларов")) Edinicy(12) = "двенадцать ": EdinicyPoslednie(12) = IIf(Valuta = 0, "двенадцать евро", IIf(Valuta = 1, "двенадцать рублей", "двенадцать долларов")) Edinicy(13) = "тринадцать ": EdinicyPoslednie(13) = IIf(Valuta = 0, "тринадцать евро", IIf(Valuta = 1, "тринадцать рублей", "тринадцать долларов")) Edinicy(14) = "четырнадцать ": EdinicyPoslednie(14) = IIf(Valuta = 0, "четырнадцать евро", IIf(Valuta = 1, "четырнадцать рублей", "четырнадцать долларов")) Edinicy(15) = "пятнадцать ": EdinicyPoslednie(15) = IIf(Valuta = 0, "пятнадцать евро", IIf(Valuta = 1, "пятнадцать рублей", "пятнадцать долларов")) Edinicy(16) = "шестнадцать ": EdinicyPoslednie(16) = IIf(Valuta = 0, "шестнадцать евро", IIf(Valuta = 1, "шестнадцать рублей", "шестнадцать долларов")) Edinicy(17) = "семнадцать ": EdinicyPoslednie(17) = IIf(Valuta = 0, "семнадцать евро", IIf(Valuta = 1, "семнадцать рублей", "семнадцать долларов")) Edinicy(18) = "восемнадцать ": EdinicyPoslednie(18) = IIf(Valuta = 0, "восемнадцать евро", IIf(Valuta = 1, "восемнадцать рублей", "восемнадцать долларов")) Edinicy(19) = "девятнадцать ": EdinicyPoslednie(19) = IIf(Valuta = 0, "девятнадцать евро", IIf(Valuta = 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(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 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 = SumBase b = Int(a) c = (a - b) * 100 If c = 0 Then c = CStr(c) + "0" d = "" If Valuta = 1 Then d = "коп." Else d = "цен." If Valuta > 2 Or Valuta < 0 Then MsgBox "Укажите параметр 0-2" If Valuta > 2 Or Valuta < 0 Then GoTo 11 ЧислоПрописьюВалюта = txt + " " + CStr(c) + d 11: End Function
Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:
- 1-рубли;
- 2-доллары;
- 0-евро;
Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).
Скачать число прописью в Excel.
Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.
Очень распространенная задача написать числа прописью в Excel. Встроенной функции пока еще в Excel нет, поэтому мы можем создать пользовательскую функцию, которая и будет заменять цифры, числа текстом.
Как правило, это требуется в торговле, бухгалтерском учете и других сферах, где производятся расчеты с денежными средствами. Обычно необходимо перевести сумму в рублях и копейках прописью, как на картинке (первый пример).
Смотрите также: Как написать сумму прописью на украинском языке
Сумма в рублях, долларах или евро с копейками прописью
Допустим, мы делаем какие-то расчеты в таблице и получаем итоговую сумму в рублях 1526,23
Нам необходимо прописать эту цифру в рублях и желательно указать так же и копейки. Для этого создадим специальную универсальную пользовательскую функцию, которая будет выглядеть следующим образом
Propis (Amount;Money;lang;Prec)
где
Amount — это ссылка на ячейку с числом
Money — тут указывается вид валюты, можно указать рубли, доллары и евро («RUB», «USD», «EUR») — валюта обязательно указывается в кавычках.
lang — это язык на котором необходимо вывести сумму, доступно два языка английский и русский («EN», «RU») — так же указываем в кавычках
Prec — показывать (1) или не показывать (0) дробную часть
Таким образом, вы сможете прописать сумму в рублях, долларах или евро прописью русскими или английскими буквами вместе с дробной частью, при этом в зависимости от числа будет вставляться правильное окончание, например 2 рубля, 8 рублей, 1 рубль и так далее.
Чтобы создать пользовательскую функцию Propis, необходимо скопировать код, указанный ниже, далее нажмите ALT+F11, чтобы открыть VBA, добавьте новый пустой модуль через меню Insert — Module и вставьте туда скопированный код
Макрос пользовательской функции суммы прописью
Function Propis(Amount As String, Optional Money As String = "RUB", Optional lang As String = "RU", Optional Prec As Integer = 1) Dim whole As Double Amount = Replace(Amount, "-", Application.International(xlDecimalSeparator)) Amount = Replace(Amount, ".", Application.International(xlDecimalSeparator)) Amount = Replace(Amount, ",", Application.International(xlDecimalSeparator)) Sum = WorksheetFunction.Round(CDbl(Amount), 2) Money = UCase(Money) lang = UCase(lang) whole = Int(Sum) fraq = Format(Round((Sum - whole) * 100), "00") Select Case Class(whole, 1) + Class(whole, 2) * 10 Case 1, 21, 31, 41, 51, 61, 71, 81, 91 w_rus_r = "рубль" w_rus_d = "доллар" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94 w_rus_r = "рубля" w_rus_d = "доллара" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" Case Else w_rus_r = "рублей" w_rus_d = "долларов" w_rus_e = "евро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" End Select Select Case fraq Case 1, 21, 31, 41, 51, 61, 71, 81, 91 f_rus_r = "копейка" f_rus_d = "цент" f_rus_e = "цент" f_rus_p = "сотая" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" f_en_e = "cents" Case 2, 3, 4, 22, 23, 24, 32, 33, 34, 42, 43, 44, 52, 53, 54, 62, 63, 64, 72, 73, 74, 82, 83, 84, 92, 93, 94 f_rus_r = "копейки" f_rus_d = "цента" f_rus_e = "цента" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" Case Else f_rus_r = "копеек" f_rus_d = "центов" f_rus_e = "центов" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" End Select If Prec = 0 Then fraq = "" f_rus_r = "" f_rus_d = "" f_rus_e = "" f_en_r = "" f_en_d = "" f_en_e = "" End If If lang = "RU" Then Select Case Money Case "RUB" Out = ScriptRus(whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r Case "USD" Out = ScriptRus(whole) & " " & w_rus_d & " " & fraq & " " & f_rus_d Case "EUR" Out = ScriptRus(whole) & " " & w_rus_e & " " & fraq & " " & f_rus_e End Select End If If lang = "EN" Then Select Case Money Case "RUB" Out = ScriptEng(whole) & " " & w_en_r & " " & fraq & " " & f_en_r Case "USD" Out = ScriptEng(whole) & " " & w_en_d & " " & fraq & " " & f_en_d Case "EUR" Out = ScriptEng(whole) & " " & w_en_e & " " & fraq & " " & f_en_e End Select End If Propis = WorksheetFunction.Trim(Out) End Function Private Function Class(m, i) Class = Int(Int(m - (10 ^ i) * Int(m / (10 ^ i))) / 10 ^ (i - 1)) End Function Private Function ScriptRus(n As Double) As String Dim Nums1, Nums2, Nums3, Nums4 As Variant Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ") Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ") Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ") If n = 0 Then ScriptRus = "Ноль" Exit Function End If ed = Class(n, 1) dec = Class(n, 2) sot = Class(n, 3) tys = Class(n, 4) dectys = Class(n, 5) sottys = Class(n, 6) mil = Class(n, 7) decmil = Class(n, 8) sotmil = Class(n, 9) mlrd = Class(n, 10) If mlrd > 0 Then Select Case mlrd Case 1 mlrd_txt = Nums1(mlrd) & "миллиард " Case 2, 3, 4 mlrd_txt = Nums1(mlrd) & "миллиарда " Case 5 To 20 mlrd_txt = Nums1(mlrd) & "миллиардов " End Select End If If (sotmil + decmil + mil) > 0 Then sotmil_txt = Nums3(sotmil) Select Case decmil Case 1 mil_txt = Nums5(mil) & "миллионов " GoTo www Case 2 To 9 decmil_txt = Nums2(decmil) End Select Select Case mil Case 1 mil_txt = Nums1(mil) & "миллион " Case 2, 3, 4 mil_txt = Nums1(mil) & "миллиона " Case 0, 5 To 20 mil_txt = Nums1(mil) & "миллионов " End Select End If www: sottys_txt = Nums3(sottys) Select Case dectys Case 1 tys_txt = Nums5(tys) & "тысяч " GoTo eee Case 2 To 9 dectys_txt = Nums2(dectys) End Select Select Case tys Case 0 If dectys > 0 Then tys_txt = Nums4(tys) & "тысяч " Case 1 tys_txt = Nums4(tys) & "тысяча " Case 2, 3, 4 tys_txt = Nums4(tys) & "тысячи " Case 5 To 9 tys_txt = Nums4(tys) & "тысяч " End Select If dectys = 0 And tys = 0 And sottys 0 Then sottys_txt = sottys_txt & " тысяч " eee: sot_txt = Nums3(sot) Select Case dec Case 1 ed_txt = Nums5(ed) GoTo rrr Case 2 To 9 dec_txt = Nums2(dec) End Select ed_txt = Nums1(ed) rrr: ScriptRus = mlrd_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt ScriptRus = UCase(Left(ScriptRus, 1)) & LCase(Mid(ScriptRus, 2, Len(ScriptRus) - 1)) End Function Private Function ScriptEng(ByVal Number As Double) Dim BigDenom As String, Temp As String Dim Count As Integer ReDim Place(9) As String Place(2) = " Thousand " Place(3) = " Million " Place(4) = " Billion " Place(5) = " Trillion " strAmount = Trim(Str(Int(Number))) Count = 1 Do While strAmount "" Temp = GetHundreds(Right(strAmount, 3)) If Temp "" Then BigDenom = Temp & Place(Count) & BigDenom If Len(strAmount) > 3 Then strAmount = Left(strAmount, Len(strAmount) - 3) Else strAmount = "" End If Count = Count + 1 Loop Select Case BigDenom Case "" BigDenom = "Zero " Case "One" BigDenom = "One " Case Else BigDenom = BigDenom & " " End Select ScriptEng = BigDenom End Function Private Function GetHundreds(ByVal MyNumber) Dim result As String If Val(MyNumber) = 0 Then Exit Function MyNumber = Right("000" & MyNumber, 3) If Mid(MyNumber, 1, 1) "0" Then result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred " End If If Mid(MyNumber, 1, 1) "0" And (Mid(MyNumber, 2, 1) "0" Or Mid(MyNumber, 3, 1) "0") Then result = result & "And " End If If Mid(MyNumber, 2, 1) "0" Then result = result & GetTens(Mid(MyNumber, 2)) Else result = result & GetDigit(Mid(MyNumber, 3)) End If GetHundreds = result End Function Private Function GetTens(TensText) Dim result As String result = "" If Val(Left(TensText, 1)) = 1 Then Select Case Val(TensText) Case 10: result = "Ten" Case 11: result = "Eleven" Case 12: result = "Twelve" Case 13: result = "Thirteen" Case 14: result = "Fourteen" Case 15: result = "Fifteen" Case 16: result = "Sixteen" Case 17: result = "Seventeen" Case 18: result = "Eighteen" Case 19: result = "Nineteen" Case Else End Select Else Select Case Val(Left(TensText, 1)) Case 2: result = "Twenty " Case 3: result = "Thirty " Case 4: result = "Forty " Case 5: result = "Fifty " Case 6: result = "Sixty " Case 7: result = "Seventy " Case 8: result = "Eighty " Case 9: result = "Ninety " Case Else End Select result = result & GetDigit _ (Right(TensText, 1)) End If GetTens = result End Function Private Function GetDigit(Digit) Select Case Val(Digit) Case 1: GetDigit = "One" Case 2: GetDigit = "Two" Case 3: GetDigit = "Three" Case 4: GetDigit = "Four" Case 5: GetDigit = "Five" Case 6: GetDigit = "Six" Case 7: GetDigit = "Seven" Case 8: GetDigit = "Eight" Case 9: GetDigit = "Nine" Case Else: GetDigit = "" End Select End Function
Итак, функция создана, чтобы воспользоваться ей, просто введите ячейке Propis с нужными аргументами, например, если нам необходимо прописать сумму прописью в рублях с копейками и на русском языке, то формула будет выглядеть следующим образом.
=Propis(B2;"RUB";"RU";1)
Числа прописью с копейками заглавными или строчными буквами в Excel
Вот код VBA для пользовательской функции. Отображение суммы прописью с копейками и выбором первой заглавной или строчной буквы
Function РубПропись(Сумма As Double, Optional Без_копеек As Boolean = False, _ Optional КопПрописью As Boolean = False, Optional начинитьПрописной As Boolean = True) As String 'Функция для написания суммы прописью Dim ed, des, sot, ten, razr, dec Dim i As Integer, str As String, s As String Dim intPart As String, frPart As String Dim mlnEnd, tscEnd, razrEnd, rub, cop dec = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") ed = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ") ten = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ") des = Array("", "", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ") sot = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ") razr = Array("", "тысяч", "миллион", "миллиард") mlnEnd = Array("ов ", " ", "а ", "а ", "а ", "ов ", "ов ", "ов ", "ов ", "ов ") tscEnd = Array(" ", "а ", "и ", "и ", "и ", " ", " ", " ", " ", " ") razrEnd = Array(mlnEnd, mlnEnd, tscEnd, "") rub = Array("рублей", "рубль", "рубля", "рубля", "рубля", "рублей", "рублей", "рублей", "рублей", "рублей") cop = Array("копеек", "копейка", "копейки", "копейки", "копейки", "копеек", "копеек", "копеек", "копеек", "копеек") If Сумма >= 1000000000000# Or Сумма < 0 Then РубПропись = CVErr(xlErrValue): Exit Function '&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& If Round(Сумма, 2) >= 1 Then intPart = Left$(Format(Сумма, "000000000000.00"), 12) For i = 0 To 3 s = Mid$(intPart, i * 3 + 1, 3) If s "000" Then str = str & sot(CInt(Left$(s, 1))) If Mid$(s, 2, 1) = "1" Then str = str & ten(CInt(Right$(s, 1))) Else str = str & des(CInt(Mid$(s, 2, 1))) & IIf(i = 2, dec(CInt(Right$(s, 1))), ed(CInt(Right$(s, 1)))) End If On Error Resume Next str = str & IIf(Mid$(s, 2, 1) = "1", razr(3 - i) & razrEnd(i)(0), _ razr(3 - i) & razrEnd(i)(CInt(Right$(s, 1)))) On Error GoTo 0 End If Next i str = str & IIf(Mid$(s, 2, 1) = "1", rub(0), rub(CInt(Right$(s, 1)))) End If РубПропись = str '''''''''''''''''' If Без_копеек = False Then frPart = Right$(Format(Сумма, "0.00"), 2) If frPart = "00" Then frPart = "" Else If КопПрописью Then frPart = IIf(Left$(frPart, 1) = "1", ten(CInt(Right$(frPart, 1))) & cop(0), _ des(CInt(Left$(frPart, 1))) & dec(CInt(Right$(frPart, 1))) & cop(CInt(Right$(frPart, 1)))) Else frPart = IIf(Left$(frPart, 1) = "1", frPart & " " & cop(0), frPart & " " & cop(CInt(Right$(frPart, 1)))) End If End If РубПропись = str & " " & frPart End If '''''''''''''''''' ' РубПропись = str & frPart If начинитьПрописной Then Mid$(РубПропись, 1, 1) = UCase(Mid$(РубПропись, 1, 1)) ' If начинитьПрописной Then РубПропись = UCase(Left(РубПропись, 1)) & Mid(РубПропись, 2) End Function
- Без копеек (1), с копейками (0)
- Копейки прописью (1), числом (0)
- Начинать прописью (0), заглавной (1)
Вот как используется функция
Примечание
- Данная функция будет работать с числами от 0 до 99 999 999
- Перед копирование кода переключите раскладку клавиатуры на русский язык (для корректного копирования русского текста)
- Код VBA необходимо вставлять во все файлы (Книги Excel), где вы хотите, чтобы она работала
- После вставки код, необходимо сохранить файл с поддержкой макросов xlsm (в Excel, начиная с 2007 версии)
- Функцию можно либо набирать в ручную, либо, если вы забыли как она пишется, через мастер функций (кнопка fx в строке формул, категория Определенные пользователем)