Blog of Khlebalin Dmitriy

(Записки из мира IT…)

Сумма прописью Excel.


Сегодня девушки из бухгалтерии попросили поправить екселевский файлик так, чтоб цифра в ячейке в ячейке прописывалась прописью…( 1С умеет это делать штатными средствами, а вот ёксель вероятно нет)

1 вариант

Встроенных функций я не обнаружил, как это сделать с помощью простой формулы, моего «скудного» ума тоже не хватило, пришлось использовать вариант на VBA.

  1. открываем ёксель
  2. нажмаем сочетание клавиш ALT+F11, чтобы открыть редактор Visual Basic
  3. добавляем новый пустой модуль через меню Insert — Module
  4. копируем и вставляем туда текст этой функции:
Function СУММАПРОПИСЬЮ(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
   СУММАПРОПИСЬЮ = "ноль"
   Exit Function
 End If
 'разделяем число на разряды, используя вспомогательную функцию Class
 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)
 
 'проверяем миллионы
 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  5 To 20
     mil_txt = Nums1(mil) & "миллионов "
 End Select
 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:
 'формируем итоговую строку
 СУММАПРОПИСЬЮ = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt
End Function
 
'вспомогательная функция для выделения из числа разрядов
Private Function Class(M, I)
  Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))
End Function

 Сохраняем файл, не забывая при этом разрешить выполнение VBA:

snap

Теперь можно вставить созданную функцию в любую ячейку листа этой книги обычным способом — через мастер функций (кнопка fx в строке формул, категория Определенные пользователем) или просто набрав ее в ячейке вручную и указав в качестве аргумента ячейку с суммой:

snap2

Если вам необходимо добавить к полученному тексту копейки, то можно воспользоваться чуть более сложной конструкцией:

=СУММАПРОПИСЬЮ(A3)&» руб. «&ТЕКСТ((A3-ЦЕЛОЕ(A3))*100;»00″)&» коп.»

=СУММАПРОПИСЬЮ(A3)&» руб. «&TEXT((A3-INT(A3))*100;»00″)&» коп.»

Тогда, например, для числа 40,11 результат функции будет выглядеть как «сорок руб. 11 коп.»

или 2 вариант

Для отображения прописью в Microsoft Excel 2010/2013/2016  необходимо скачать надстройку   NUM2TEXT , сохранить на компьютере в любую папку, и затем добавить в надстройки как показано ниже на картинках.

После выполнения указанных операций функция «Сумма_прописью» и «Пропись_суммой» будут доступны…

Или можно выбрать мышкой

Всем хорошей работы !!!

P.S. Если существует решение реализуемое простой формулой (без использования VBA), для общего кругозора, прошу написать варианты в комментариях…

Реклама

29.10.2014 - Posted by | ms office 2003/2007/2010/2013/365

2 комментария

  1. Есть решение, не изящное, но зато без макросов.
    Для тех, кто категорически против применения различного рода макросов в документах MS Office. Эта примочка была доступна на сайте, который сейчас почему-то не работает… http://www.allok.ru/ У меня есть этот пример, но прикрепить его здесь не получится.

    Либо здесь описано множество вариантов: http://forum.ixbt.com/topic.cgi?id=23:4497#7

    комментарий от Анатолий | 29.10.2014

    • Многие из них я даже попробовал, но большинство не работает 😦

      комментарий от khlebalin | 29.10.2014


Sorry, the comment form is closed at this time.

%d такие блоггеры, как: