Как прописать сумму, число, цифры прописью в Excel

Очень распространенная задача написать числа прописью в Excel. Встроенной функции пока еще в 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 в строке формул, категория Определенные пользователем)
Поделиться:
47 Комментариев
  • Светлана says:

    У меня тоже не работает после закрытия, сохраняла с поддержкой макроса. Что может быть не так? Спасибо

  • Алла says:

    Добрый день.

    Ничего не работает. До обновления офиса все работало с файлом NUMSTR.XLA. Сейчас ругается на VBA. Как исправить? Хоть не обновляйся!!! Все говорят распространенная проблема, так что же не включить сразу в обновления, зачем терять столько времени и нервов, особенно не очень опытным пользователям?

  • Алена says:

    Вставляю код, все работает. Закрываю книгу и снова не работает. Сохранила на файл с поддержкой макросов.

  • Алексей says:

    Добрый день! Не могли бы Вы доработать ваш код, чтобы, например, число 933,92 выводилось в следующем виде: «Итого: 933,92 евро (Девятьсот тридцать три евро 92 цента), в том числе НДС 142,46 евро (Сто сорок два евро 46 центов). „ ?

    PS: Выбор валюты важно оставить. НДС =“число»/118*18

    • Алексей says:

      Уже сделал сам. Спасибо за исходник!

  • павел says:

    скажите. добавляю макрос, сохраняю. все работает. закрываю книгу, открываю заново и не работает. в чем может быть дело?

    • excel says:

      После вставки код, необходимо сохранить файл с поддержкой макросов xlsm (в Excel, начиная с 2007 версии)

      • Елена says:

        Я сделала, но все равно не работает, когда снова открываешь книгу ((

        • excel says:

          У вас файл в итоге в формате .xlsm ?

          Проверьте, должно все работать

  • БуКа says:

    Спасибо! Кстати, Ноль рублей 51 копейка выдает на число -5055,00, если добавить копейки, то вывалится в #ЗНАЧ!

    • excel says:

      Это в каком варианте?

  • Вадим says:

    будет правильнее =Propis (B2; «RUB»; «RU»;1), а не =Propis (B2; «RUB»; «RU»;1)

    • excel says:

      Все верно, это проблемы отображения на сайте. Исправил — спасибо

  • Юлия says:

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

    • excel says:

      Проверил, макрос отлично работает.

  • Павел says:

    Здравствуйте!

    Можно как-то сделать что бы не вставлять в каждую книгу?

    • excel says:

      Чтобы макрос был доступен во всех книгах его необходимо добавить в личную книгу макросов Personal.xlsb

      Создайте модуль в редакторе в VBA в книге VBAProject (PERSONAL.XLSB)

      и скопируйте макрос туда.

      Если этой книге нет, то запустите макрорекордер и запишите любой макрос при его сохранении выберите «сохранить в» вместо «Эта книга» «Личная книга макросов». После этого PERSONAL.XLSB у вас должна появиться

  • Марина says:

    VBA не открывается с помощью указанной комбинации клавиш 🙁 Через меню можно как-то открыть?

    • excel says:

      Правой кнопкой мыши на лист Excel и выбрать «Исходный текст»

  • Светлана says:

    Здравствуйте А можно ли сделать чтобы и копейки были прописью Пример : Двадцать рублей пятнадцать копеек ?

    • excel says:

      Вот макрос, у функции 4 параметра:

      ссылка на число

      Без копеек (1), с копейками (0)

      Копейки прописью (1), числом (0)

      Начинать прописью (0), заглавной (1)

      прописью

      • Элвис says:

        вложение

        Вот так открывается ссылка, причем на разных браузерах, и с разными настройками кодировки

        • excel says:

          Добавил код в статью

          • Анд says:

            Благодарю, это единственный код который адекватно заработал с копейками! Подскажите еще какие значения нужно поставить, что бы отображались нулевые значения?

      • Лилия says:

        Здравствуйте. Макрос по этой ссылке не корректно открывается. Можно его сразу для скачивания?

        • excel says:

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

          • Лилия says:

            Отлично. Работает. Спасибо огромное!!!

  • Светлана says:

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

  • Надежда says:

    Добрый день.У меня эта функция не работает!

  • Денис says:

    ОГРОМНОЕ СПАСИБО!! В нете море инфы как это сделать, но получилось только с помощью этого кода!!!!!

  • Виктория says:

    Спасибо! Все работает.

    P.S.:А как можно сделать чтоб прописывалось целое число без слов рублей и копеек и с маленькой буквы?

    Пример: «двадцать одна тысяча триста тридцать шесть»

    • excel says:

      Найдите в коде вот такую строчку (для русского языка)

      Out = ScriptRus (whole) & " " & w_rus_r & " " & fraq & " " & f_rus_r

      и поменяйте на

      Out = ScriptRus (whole) & " " & fraq

      формулу пишите так:

      =Propis (A1; «RUB»; «RU»;0)

      • excel says:

        Чтобы сделать все буквы в нижнем регистре найдите вот эту строчку

        ScriptRus = UCase (Left (ScriptRus, 1)) & LCase (Mid (ScriptRus, 2, Len (ScriptRus) — 1))

        и поменяйте один символ U на L

        ScriptRus = LCase (Left (ScriptRus, 1)) & LCase (Mid (ScriptRus, 2, Len (ScriptRus) — 1))

        • Виктория says:

          Огромное спасибо))) Все сделала как написано))) Все работает)))

  • Ольга says:

    Спасибо большое, все работает!

  • Наталья says:

    Огромное спасибо автору. Все работает, просто замечательно!

  • Анастасия says:

    Код копируется не корректно, на всех раскладках.

  • Ирина says:

    Спасибо! Работает.

    Только как сделать на доллары и евро? Подскажите пожалуйста

    • excel says:

      Нужно поменять второй аргумент «Money». Смотрите описание, там все расписано

  • Максим says:

    Огромное спасибо! Работет!

  • Евгения says:

    Спасибо за ваши труды!

    Одно «Но»: макрос не работает, если сумма, к примеру, 55 000, прописывает только «пять тысяч рублей»

  • Ярослав says:

    вложение  UA.xls

    Спасиба огромное, все работает!

    Добавил украинский язык, если нада. Старался не повредить, в фунцию добавлено UA для украинского, UAN для гривны

  • полина says:

    Спасибо большое!!! Большущее!

  • манагер says:

    Спасибо большое, работает!

  • ЫЫ says:

    Спасибо автору. Все работает.

Добавить комментарий

Ваш e-mail не будет опубликован. Все поля обязательны для заполнения.