Як прописати суму, число, цифри прописом в excel

Відео: Сума прописом в excel. Швидка настройка

Дуже поширена завдання написати числа прописом в Excel. Вбудованої функції поки що в Excel немає, тому ми можемо створити для користувача функцію, яка і буде замінювати цифри, числа текстом.

Як правило, це потрібно в торгівлі, бухгалтерський облік та інших сферах, де здійснюються розрахунки з грошовими коштами. Зазвичай необхідно перевести суму в рублях і копійках прописом, як на картинці (перший приклад).

Відео: Число, сума прописом в Excel

Дивіться також: Як написати суму прописом українською мовою

Сума в рублях, доларах або євро з копійками прописом

Припустимо, ми робимо якісь розрахунки в таблиці і отримуємо підсумкову суму в рублях 1526,23

Нам необхідно прописати цю цифру в рублях і бажано вказати так само і копійки. Для цього створимо спеціальну універсальну для користувача функцію, яка буде виглядати наступним чином

Propis (Amount-Money-lang-Prec)

де

Таким чином, ви зможете прописати суму в рублях, доларах або євро прописом російськими або англійськими літерами разом з дробової частиною, при цьому в залежності від числа вставлятиметься правильне закінчення, наприклад 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 DoubleAmount = 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 ) * 10Case 1, 21, 31, 41, 51, 61, 71, 81, 91w_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, 94w_rus_r = "рубля" w_rus_d = "долара" w_rus_e = "євро" w_en_r = "rubles" w_en_d = "dollars" w_en_e = "euro" Case Elsew_rus_r = "рублів" w_rus_d = "д лларов "w_rus_e =" євро "w_en_r =" rubles "w_en_d =" dollars "w_en_e =" euro "End SelectSelect Case fraqCase 1, 21, 31, 41, 51, 61, 71, 81, 91f_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, 94f_rus_r = "копійки" f_rus_d = "цента" f_rus_e = "цента" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" Case Elsef_rus_r = "копійок" f_rus_d = "центів" f_rus_e = "центів" f_en_r = "kopecks" f_en_d = "cents" f_en_e = "cents" End SelectIf Prec = 0 Thenfraq = "" f_rus_r = "" f_rus_d = "" f_rus_e = "" f_en_r = "" f_en_d = "" f_en_e = "" End IfIf lang = "RU" ThenSelect Case MoneyCase "RUB" Out = ScriptRus (whole) "" w_rus_r "" fraq "" f_rus_rCase "USD" Out = ScriptRus (whole) "" w_rus_d "" fraq "" f_rus_dCase "EUR" Out = ScriptRus (whole) "" w_rus_e "" fraq "" f_rus_eEnd SelectEnd IfIf lang = "EN" ThenSelect Case MoneyCase "RUB" Out = ScriptEng (whole) "" w_en_r "" fraq "" f_en_rCase "USD" Out = ScriptEng (whole) "" w_en_d "" fraq "" f_en_dCase "EUR" Out = ScriptEng (whole) "" w_en_e "" fraq "" f_en_eEnd SelectEnd IfPropis = WorksheetFunction.Trim (Out) End FunctionPrivate Function Class (m, i) Class = Int (Int (m - (10 ^ i) * Int (m / (10 ^ i))) / 10 ^ (i - 1)) End FunctionPrivate Function ScriptRus (n As Double) As StringDim Nums1, Nums2, Nums3, Nums4 As VariantNums1 = Array ( "", "один", "два", "три", "чотири", "п`ять", " шість "," сім "," вісім "," дев`ять ") Nums2 = Array (" "," десять "," двадцять "," тридцять "," сорок "," п`ятдесят "," шістдесят "," сімдесят ", "вісімдесят", "дев`яносто") Nums3 = Array ( "", "сто", "двісті", "триста", "чотириста", "п`ятсот", "шістсот", "сімсот", "вісімсот", "дев`ятсот" ) Nums4 = Array ( "", "одна", "дві", "три", "чотири", "п`ять", "шість", "сім", "вісім", "дев`ять") Nums5 = Array ( "десять "," один цять "," дванадцять "," тринадцять "," чотирнадцять "," п`ятнадцять "," шістнадцять "," сімнадцять "," вісімнадцять "," дев`ятнадцять ") If n = 0 ThenScriptRus =" Нуль "Exit FunctionEnd Ifed = 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 gt; 0 ThenSelect Case mlrdCase 1mlrd_txt = Nums1 (mlrd) "Мільярд" Case 2, 3, 4mlrd_txt = Nums1 (mlrd) "Мільярди" Case 5 To 20mlrd_txt = Nums1 (mlrd) "Мільярдів" End SelectEnd IfIf (sotmil + decmil + mil) gt; 0 Thensotmil_txt = Nums3 (sotmil) Select Case decmilCase 1mil_txt = Nums5 (mil) "Мільйонів" GoTo wwwCase 2 To 9decmil_txt = Nums2 (decmil) End SelectSelect Case milCase 1mil_txt = Nums1 (mil) "Мільйон" Case 2, 3, 4mil_txt = Nums1 (mil) "Мільйони" Case 0, 5 To 20mil_txt = Nums1 (mil) "Мільйонів" End SelectEnd Ifwww: sottys_txt = Nums3 (sottys) Select Case dectysCase 1tys_txt = Nums5 (tys) "Тисяч" GoTo eeeCase 2 To 9dectys_txt = Nums2 (dectys) End SelectSelect Case tysCase 0If dectys gt; 0 Then tys_txt = Nums4 (tys) "Тисяч" Case 1tys_txt = Nums4 (tys) "Тисяча" Case 2, 3, 4tys_txt = Nums4 (tys) "Тисячі" Case 5 To 9tys_txt = Nums4 (tys) "Тисяч" End SelectIf dectys = 0 And tys = 0 And sottys lt; gt; 0 Then sottys_txt = sottys_txt "Тисяч" eee: sot_txt = Nums3 (sot) Select Case decCase 1ed_txt = Nums5 (ed) GoTo rrrCase 2 To 9dec_txt = Nums2 (dec) End Selected_txt = Nums1 (ed) rrr: ScriptRus = mlrd_txt sotmil_txt decmil_txt mil_txt sottys_txt dectys_txt tys_txt sot_txt dec_txt ed_txtScriptRus = UCase (Left (ScriptRus, 1)) LCase (Mid (ScriptRus, 2, Len (ScriptRus) - 1)) End FunctionPrivate Function ScriptEng (ByVal Number As Double) Dim BigDenom As String, Temp As StringDim Count As IntegerReDim Place (9) As StringPlace (2) = "Thousand" Place (3) = "Million" Place (4) = "Billion" Place (5) = "Trillion" strAmount = Trim (Str (Int (Number))) Count = 1Do While strAmount lt; gt; "" Temp = GetHundreds (Right (strAmount, 3)) If Temp lt; gt; "" Then BigDenom = Temp Place (Count) BigDenomIf Len (strAmount) gt; 3 ThenstrAmount = Left (strAmount, Len (strAmount) - 3) ElsestrAmount = "" End IfCount = Count + 1LoopSelect Case BigDenomCase "" BigDenom = "Zero" Case "One" BigDenom = "One" Case ElseBigDenom = BigDenom "" End SelectScriptEng = BigDenomEnd FunctionPrivate Function GetHundreds (ByVal MyNumber) Dim result As StringIf Val (MyNumber) = 0 Then Exit FunctionMyNumber = Right ( "000" MyNumber, 3) If Mid (MyNumber, 1, 1) lt; gt; "0" Thenresult = GetDigit (Mid (MyNumber, 1, 1)) "Hundred" End IfIf Mid (MyNumber, 1, 1) lt; gt; "0" And (Mid (MyNumber, 2, 1) lt; gt; "0" Or Mid (MyNumber, 3, 1) lt; gt; "0") Thenresult = result "And" End IfIf Mid (MyNumber, 2, 1) lt; gt; "0" Thenresult = result GetTens (Mid (MyNumber, 2)) Elseresult = result GetDigit (Mid (MyNumber, 3)) End IfGetHundreds = resultEnd FunctionPrivate Function GetTens (TensText) Dim result As Stringresult = "" If Val (Left (TensText, 1)) = 1 ThenSelect 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 ElseEnd SelectElseSelect 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 ElseEnd Selectresult = result GetDigit _ (Right (TensText, 1)) End IfGetTens = resultEnd FunctionPrivate 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 SelectEnd 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, decDim i As Integer , str As String, s As StringDim intPart As String, frPart As StringDim mlnEnd, tscEnd, razrEnd, rub, copdec = Array ( "", "одна", "дві", "три", "чотири", "п`ять", "шість", "сім", "вісім", "дев`ять") ed = Array ( "", "один", "два", "три", "чотири", "п`ять", "шість", "сім" , "вісім", "дев`ять") ten = Array ( "десять", "одинадцять", "дванадцять", "тринадцять", "чотирнадцять", "п`ятнадцять", "шістнадцять", "сімнадцять", "вісімнадцять", " дев`ятнадцять ") d es = Array ( "", "", "двадцять", "тридцять", "сорок", "п`ятдесят", "шістдесят", "сімдесят", "вісімдесят", "дев`яносто") sot = Array ( "", " сто "," двісті "," триста "," чотириста "," п`ятсот "," шістсот "," сімсот "," вісімсот "," дев`ятсот ") razr = Array (" "," тисяч "," мільйон ", "мільярд") mlnEnd = Array ( "ов", "", "а", "а", "а", "ов", "ов", "ов", "ов", "ов") tscEnd = Array ( "", "а", "і", "і", "і", "", "", "", "", "") razrEnd = Array (mlnEnd, mlnEnd, tscEnd, "") rub = Array ( "рублів", "рубль", "рубля", "рубля", "рубля", "рублів", "рублів", "рублів", "рублів", "рублів") cop = Array ( "копійок", "копійка", "копійки", "копійки", "копійки", "копійок", "копійок", "копійок", "копійок", "копее ") If Сума gt; = 1000000000000 # Or Сума lt; 0 Then РубПропісь = CVErr (xlErrValue): Exit Function`If Round (Сума, 2) gt; = 1 ThenintPart = Left $ (Format (Сума, "000000000000.00"), 12) For i = 0 To 3s = Mid $ (intPart, i * 3 + 1, 3) If s lt; gt; "000" Thenstr = str sot (CInt (Left $ (s, 1))) If Mid $ (s, 2, 1) = "1" Thenstr = str ten (CInt (Right $ (s, 1))) Elsestr = str des (CInt (Mid $ (s, 2, 1))) IIf (i = 2, dec (CInt (Right $ (s, 1))), ed (CInt (Right $ (s, 1)))) End IfOn Error Resume Nextstr = 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 0End IfNext istr = str IIf (Mid $ (s, 2, 1) = "1", rub (0), rub (CInt (Right $ (s, 1)))) End IfРубПропісь = str `` `` `` `` `` ` `` `` `` `If Без_копеек = False ThenfrPart = Right $ (Format (Сума, "0.00"), 2) If frPart = "00" ThenfrPart = "" ElseIf КопПропісью ThenfrPart = 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)))) ElsefrPart = IIf (Left $ (frPart, 1) = "1", frPart "" cop (0), frPart "" cop (CInt (Right $ (frPart, 1)))) End IfEnd IfРубПропісь = str "" frPartEnd If `` `` `` `` `` `` `` `` `` `РубПропісь = str frPartIf начінітьПропісной 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 в рядку формул, категорія Певні користувачем)