Сума, число, цифри прописом в Exce

Пятница, 01 Августа 2014 г. 01:25 + в цитатник

 

Сума, число, цифри прописом в Excel

Дуже часто буває що нам необхідно відобразити цифри прописом (наприклад, відобразити прописом кількість сторінок в документі), або для цілей бухгалтерського обліку, вартість торгівельної операції потрібно прописувати словами, тобто необхідна сума прописом, проте в Excel немає стандартної функції для таких цілей. Нижче ви знайдете готову функцію на VBA, яка переводить будь-яке число в його текстове відображення українською мовою, тобто в суму прописом. Перед використанням, цю функцію необхідно додати у вашу книгу. Для цього:
  1. Натисніть клавіші ALT + F11 , щоб відкрити редактор Visual Basic
  2. Додайте новий порожній модуль через меню Insert - Module
  3. Скопіюйте і вставте туди текст цієї функції:
  1. Function SUMINWORDS(n As Double, curr As Variant, kop As VariantAs String  
  2.  'moonexcel.com.ua   
  3.  Dim Nums1, Nums2, Nums3, Nums4 As Variant  
  4.    
  5.  Nums0 = Array("""одна ""дві ""три ""чотири ""п'ять ""шість ""сім ""вісім ""дев'ять ")  
  6.  Nums1 = Array("""один ""два ""три ""чотири ""п'ять ""шість ""сім ""вісім ""дев'ять ")  
  7.  Nums2 = Array("""десять ""двадцять ""тридцять ""сорок ""п'ятдесят ""шістдесят ""сімдесят ", _  
  8.                         "вісімдесят ""дев'яносто ")  
  9.  Nums3 = Array("""сто ""двісті ""триста ""чотириста ""п'ятсот ""шістсот ""сімсот ", _  
  10.                         "вісімсот ""дев'ятсот ")  
  11.  Nums4 = Array("""одна ""дві ""три ""чотири ""п'ять ""шість ""сім ""вісім ""дев'ять ")  
  12.  Nums5 = Array("десять ""одинадцять ""дванадцять ""тринадцять ""чотирнадцять ", _  
  13.                         "п'ятнадцять ""шістнадцять ""сімнадцять ""вісімнадцять ""дев'ятнадцять ")  
  14.     
  15.  If n < 1 Then  
  16.    SUMINWORDS = "Нуль " & curr & " " & Round((n - Fix(n)) * 100) & " " & kop  
  17.      
  18. If curr = "" Then  
  19.    SUMINWORDS = "Нуль"  
  20. End If  
  21.         
  22.    Exit Function  
  23.  End If  
  24.  'розділяємо число на розряди, використовуючи допоміжну функцію Class  
  25.  ed = Class(n, 1)  
  26.  dec = Class(n, 2)  
  27.  sot = Class(n, 3)  
  28.  tys = Class(n, 4)  
  29.  dectys = Class(n, 5)  
  30.  sottys = Class(n, 6)  
  31.  mil = Class(n, 7)  
  32.  decmil = Class(n, 8)  
  33.  sotmil = Class(n, 9)  
  34.  bil = Class(n, 10)  
  35.      
  36. 'перевіряємо мільярди  
  37.    
  38.  Select Case bil  
  39.    
  40. Case 1  
  41.      bil_txt = Nums1(bil) & "мільярд "  
  42. Case 2 To 4  
  43.      bil_txt = Nums1(bil) & "мільярди "  
  44. Case 5 To 9  
  45.      bil_txt = Nums1(bil) & "мільярдів "  
  46.             
  47.  End Select  
  48.      
  49. 'перевіряємо мільйони  
  50.    
  51.  Select Case sotmil  
  52.    Case 1 To 9  
  53.      sotmil_txt = Nums3(sotmil)  
  54.  End Select  
  55.     
  56.  Select Case decmil  
  57.    Case 1  
  58.      mil_txt = Nums5(mil) & "мільйонів "  
  59.      GoTo www  
  60.    Case 2 To 9  
  61.      decmil_txt = Nums2(decmil)  
  62.  End Select  
  63.    
  64.  Select Case mil  
  65.  Case 0  
  66.      If decmil > 0 Then mil_txt = Nums4(mil) & "мільйонів "  
  67.    Case 1  
  68.      mil_txt = Nums1(mil) & "мільйон "  
  69.    Case 2, 3, 4  
  70.      mil_txt = Nums1(mil) & "мільйона "  
  71.    Case 5 To 9  
  72.      mil_txt = Nums1(mil) & "мільйонів "  
  73.  End Select  
  74.    
  75.  If decmil = 0 And mil = 0 And sotmil <> 0 Then sotmil_txt = sotmil_txt & "мільйонів "  
  76.    
  77. www:  
  78.  sottys_txt = Nums3(sottys)  
  79.  'перевіряємо тисячі  
  80.  Select Case dectys  
  81.    Case 1  
  82.      tys_txt = Nums5(tys) & "тисяч "  
  83.      GoTo eee  
  84.    Case 2 To 9  
  85.      dectys_txt = Nums2(dectys)  
  86.  End Select  
  87.    
  88.  Select Case tys  
  89.    Case 0  
  90.      If dectys > 0 Then tys_txt = Nums4(tys) & "тисяч "  
  91.    Case 1  
  92.      tys_txt = Nums4(tys) & "тисячa "  
  93.    Case 2, 3, 4  
  94.      tys_txt = Nums4(tys) & "тисячі "  
  95.    Case 5 To 9  
  96.      tys_txt = Nums4(tys) & "тисяч "  
  97.  End Select  
  98.    
  99.  If dectys = 0 And tys = 0 And sottys <> 0 Then sottys_txt = sottys_txt & " тисяч "  
  100.    
  101. eee:  
  102.  sot_txt = Nums3(sot)  
  103.  'перевіряємо десятки  
  104.  Select Case dec  
  105.    Case 1  
  106.      ed_txt = Nums5(ed)  
  107.      GoTo rrr  
  108.    Case 2 To 9  
  109.      dec_txt = Nums2(dec)  
  110.  End Select  
  111.     
  112.  ed_txt = Nums0(ed)  
  113.   
  114. rrr:  
  115. 'формуємо підсумковий рядок  
  116.    
  117.  SUMINWORDS = bil_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt _  
  118.  & tys_txt & sot_txt & dec_txt & ed_txt & curr & " " & Round((n - Fix(n)) * 100) & " " & kop  
  119.   
  120. If curr = "" Then  
  121.    SUMINWORDS = bil_txt & sotmil_txt & decmil_txt & mil_txt & sottys_txt & dectys_txt _  
  122.  & tys_txt & sot_txt & dec_txt & ed_txt  
  123.  End If  
  124.    
  125.  SUMINWORDS = UCase(Mid(SUMINWORDS, 1, 1)) + Mid(SUMINWORDS, 2)  
  126.    
  127. End Function  
  128.     
  129. 'допоміжна функція для виділення з числа розрядів  
  130. Private Function Class(M, I)  
  131.   Class = Int(Int(M - (10 ^ I) * Int(M / (10 ^ I))) / 10 ^ (I - 1))  
  132. End Function  

Збережіть файл та поверніться в Excel. Тепер ви можете вставити створену функцію в будь-яку комірку аркуша цієї книги звичайним способом - через майстер функцій (кнопка в рядку формул, категорія Визначені користувачем ) або просто набравши її в комірці вручну і вказавши в якості аргументу комірку з сумою. Також, в параметрах функції можна зазначати назву валюти (гривня, долар, євро...) та назву сотих (копійки, центи...):

=SUMINWORDS(текст;валюта;соті)

Якщо в параметрі "валюта" проставити порожні подвійні лапки (""), тоді сума буде виводитись як ціле число прописом:

 

 



Процитировано 1 раз