Русский Русская версия English English version

Как перевести сумму или число прописью в Excel

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

Для создания пользовательской функции, которая сможет перевести число в текст прописью , нам нужно выполнить 3 простых шага:

  1. Открыть редактор макросов ALT+F11.
  2. Создать новый модуль и в нем нужно написать функцию особенным способом: Function вместо Sub. Тогда наша функция «ЧислоПропись» будет отображаться в списке мастера функций (SHIFT+F3), в категории «Определенные пользователем».
  3. Module.
  4. Вставить в модуль следующий код и сохранить:

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. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.

Скачать число прописью в Excel.