Как перевести сумму или число прописью в 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
'до 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
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
End Sub
Кроме того благодаря данному макросу DescribeFunction функция будет доступна в группе: «ФОРМУЛЫ»-«Библиотека функций»-«Финансовые»-«ЧислоПрописьюВалюта»
Если мы указываем число (от 0 до 2)в параметре второй функции «ЧислоПрописьюВалюта» то функция автоматически подставит нужную валюту в сумме прописью:
- 1-рубли;
- 2-доллары;
- 0-евро;
Как видите, этот VBA-код макроса преобразует числа в слова. После вставки данного кода в модуль редактора макросов, у нас работает новая функция, которую можно вызвать из мастера (кнопка fx возле строки формул).
Скачать число прописью в Excel руб RUB.
Украинская версия функции ЧислоСловоВалюта для перевода сумм в гривны находиться в следующем файле:
Скачать функцию ЧислоСловоВалюта ГРН UAH
Теперь вы можете быстро перевести сумму в слова прописью. Чтобы воспользоваться готовым решением рекомендуем скачать пример числа прописью в Excel. Данный файл содержит уже готовую пользовательскую функцию и VBA-код макроса, который доступен в модуле из редактора.
