Домашняя страница Undo Do Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 35654
Главная » Готовые решения » VBA » Пользовательские функции

Перевод чисел в текст
31.07.2013, 17:55

Function ABC_123(n)
 Dim Nums1, Nums2, Nums3, Nums4 As Variant
 Nums1 = Array("", "один ", "два ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums2 = Array("", "десять ", "двадцать ", "тридцать ", "сорок ", "пятьдесят ", "шестьдесят ", "семьдесят ", "восемьдесят ", "девяносто ")
 Nums3 = Array("", "сто ", "двести ", "триста ", "четыреста ", "пятьсот ", "шестьсот ", "семьсот ", "восемьсот ", "девятьсот ")
 Nums4 = Array("", "одна ", "две ", "три ", "четыре ", "пять ", "шесть ", "семь ", "восемь ", "девять ")
 Nums5 = Array("десять ", "одиннадцать ", "двенадцать ", "тринадцать ", "четырнадцать ", "пятнадцать ", "шестнадцать ", "семнадцать ", "восемнадцать ", "девятнадцать ")
 
 koma_txt = ""
 dr_decmil = ""
 dr_mil = ""
 dr_sottys = ""
 dr_dectys = ""
 dr_tys = ""
 dr_sot = ""
 dr_dec = ""
 dr_ed = ""
 konec = ""
 
 
 If n <= 0 Then CHISLOPROPIS = "ноль"
 If n <= 0 Then Exit Function
 
 ed = Int(Int(n - (10 ^ 1) * Int(n / (10 ^ 1))) / 10 ^ (1 - 1))
 dec = Int(Int(n - (10 ^ 2) * Int(n / (10 ^ 2))) / 10 ^ (2 - 1))
 sot = Int(Int(n - (10 ^ 3) * Int(n / (10 ^ 3))) / 10 ^ (3 - 1))
 tys = Int(Int(n - (10 ^ 4) * Int(n / (10 ^ 4))) / 10 ^ (4 - 1))
 dectys = Int(Int(n - (10 ^ 5) * Int(n / (10 ^ 5))) / 10 ^ (5 - 1))
 sottys = Int(Int(n - (10 ^ 6) * Int(n / (10 ^ 6))) / 10 ^ (6 - 1))
 mil = Int(Int(n - (10 ^ 7) * Int(n / (10 ^ 7))) / 10 ^ (7 - 1))
 decmil = Int(Int(n - (10 ^ 8) * Int(n / (10 ^ 8))) / 10 ^ (8 - 1))
 
 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) & "тысячa "
 Case 2, 3, 4
 tys_txt = Nums4(tys) & "тысячи "
 Case 5 To 9
 tys_txt = Nums4(tys) & "тысяч "
 End Select
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
rrr:
 Cel = Fix(n)
 If Len(n) = Len(Cel) Then ed_txt = Nums1(ed) Else ed_txt = Nums4(ed)
 If ed_txt = Nums4(1) Then koma_txt = "целая" Else koma_txt = "целых"
 If Len(n) = Len(Cel) Then koma_txt = ""
 If Len(n) = Len(Cel) Then GoTo ttt
 
 drob = -Int(-(n * 10 ^ (Len(n) - Len(Cel) - 1)) - -(Cel * 10 ^ (Len(n) - Len(Cel) - 1)))
 dr_ed = Int(Int(drob - (10 ^ 1) * Int(drob / (10 ^ 1))) / 10 ^ (1 - 1))
 dr_dec = Int(Int(drob - (10 ^ 2) * Int(drob / (10 ^ 2))) / 10 ^ (2 - 1))
 dr_sot = Int(Int(drob - (10 ^ 3) * Int(drob / (10 ^ 3))) / 10 ^ (3 - 1))
 dr_tys = Int(Int(drob - (10 ^ 4) * Int(drob / (10 ^ 4))) / 10 ^ (4 - 1))
 dr_dectys = Int(Int(drob - (10 ^ 5) * Int(drob / (10 ^ 5))) / 10 ^ (5 - 1))
 dr_sottys = Int(Int(drob - (10 ^ 6) * Int(drob / (10 ^ 6))) / 10 ^ (6 - 1))
 dr_mil = Int(Int(drob - (10 ^ 7) * Int(drob / (10 ^ 7))) / 10 ^ (7 - 1))
 dr_decmil = Int(Int(drob - (10 ^ 8) * Int(drob / (10 ^ 8))) / 10 ^ (8 - 1))
 
 ' drob = Fix((m - cel) * 10 ^ (Len(m) - Len(cel) - 1))
 
 Select Case dr_decmil
 Case 1
 dr_mil_txt = Nums5(dr_mil) & "миллионов "
 GoTo www1
 Case 2 To 9
 dr_decmil_txt = Nums2(dr_decmil)
 End Select

 Select Case dr_mil
 Case 1
 dr_mil_txt = Nums1(dr_mil) & "миллион "
 Case 2, 3, 4
 dr_mil_txt = Nums1(dr_mil) & "миллиона "
 Case 5 To 20
 dr_mil_txt = Nums1(dr_mil) & "миллионов "
 End Select
www1:
 dr_sottys_txt = Nums3(dr_sottys)
 Select Case dr_dectys
 Case 1
 dr_tys_txt = Nums5(dr_tys) & "тысяч "
 GoTo eee1
 Case 2 To 9
 dr_dectys_txt = Nums2(dr_dectys)
 End Select

 Select Case dr_tys
 Case 0
 If dr_dectys > 0 Then dr_tys_txt = Nums4(dr_tys) & "тысяч "
 Case 1
 dr_tys_txt = Nums4(dr_tys) & "тысячa "
 Case 2, 3, 4
 dr_tys_txt = Nums4(dr_tys) & "тысячи "
 Case 5 To 9
 dr_tys_txt = Nums4(dr_tys) & "тысяч "
 End Select
eee1:
 dr_sot_txt = Nums3(dr_sot)

 Select Case dr_dec
 Case 1
 dr_ed_txt = Nums4(dr_ed)
 GoTo ppp
 Case 2 To 9
 dr_dec_txt = Nums2(dr_dec)
 End Select
ppp:
 Select Case dr_ed
 Case 1
 dr_ed_txt = Nums4(dr_ed)
 Case 2
 dr_ed_txt = Nums4(dr_ed)
 Case 3 To 9
 dr_ed_txt = Nums1(dr_ed)
 End Select

konec_znach = Len(n) - Len(Cel) - 1
Select Case konec_znach
 Case 1
 If dr_ed_txt = Nums4(1) Then konec = "десятая" _
 Else: konec = "десятых"
 Case 2
 If dr_ed_txt = Nums4(1) Then konec = "сотая" _
 Else: konec = "сотых"
 Case 3
 If dr_ed_txt = Nums4(1) Then konec = "тысячная" _
 Else: konec = "тысячных"
 Case 4
 If dr_ed_txt = Nums4(1) Then konec = "десятитысячная" _
 Else: konec = "десятитысячных"
 Case 5
 If dr_ed_txt = Nums4(1) Then konec = "стотысячная" _
 Else: konec = "стотысячных"
 Case 6
 If dr_ed_txt = Nums4(1) Then konec = "миллионная" _
 Else: konec = "миллионных"
 Case 7
 If dr_ed_txt = Nums4(1) Then konec = "десятимиллионная" _
 Else: konec = "десятимиллионных"
 End Select
 If konec_znach > 7 Then konec = "...очень маленькая..."
ttt:
 ABC_123 = decmil_txt & mil_txt & sottys_txt & dectys_txt & tys_txt & sot_txt & dec_txt & ed_txt & koma_txt & " " & dr_decmil_txt & dr_mil_txt & dr_sottys_txt & dr_dectys_txt & dr_tys_txt & dr_sot_txt & dr_dec_txt & dr_ed_txt & konec
 
End Function
Добавил: Serge_007 | | Теги: числа в текст, VBA, Перевод чисел в текст, number_to_text, ВБА
Просмотров: 15141 | Рейтинг: 0.0/0
Всего комментариев: 5
0   Спам
1    MCH   (04.08.2013 15:31)
   Функция не корректная:
1. в слове "тысячa", "a" - латинская
2. начальный ноль не воспринимает
3. неверно работает с числами от 10 до 20 (аналогично с 110-119 и т.п.)
4. при попытке написать более 8 знаков после запятой - не верно формирует дробное числительное

ЗЫ: Напоминает пропись от НВП, унаследовав ошибки с "тысяча" и нулем
Пользоваться без доработок не рекомендую

0   Спам
2    Serge_007   (04.08.2013 15:54)
   Где брал не помню, автора тоже

0   Спам
3    Гисер   (27.09.2013 11:00)
   =ПОДСТАВИТЬ(ПРОПНАЧ(ИНДЕКС(n_4;ПСТР(ТЕКСТ(A3;n0);1;1)+1)&ИНДЕКС(n0x;ПСТР(ТЕКСТ(A3;n0);2;1)+1;ПСТР(ТЕКСТ(A3;n0);3;1)+1)&ЕСЛИ(-ПСТР(ТЕКСТ(A3;n0);1;3);"миллиард"&ВПР(ПСТР(ТЕКСТ(A3;n0);3;1)*И(ПСТР(ТЕКСТ(A3;n0);2;1)-1);мил;2);"")&ИНДЕКС(n_4;ПСТР(ТЕКСТ(A3;n0);4;1)+1)&ИНДЕКС(n0x;ПСТР(ТЕКСТ(A3;n0);5;1)+1;ПСТР(ТЕКСТ(A3;n0);6;1)+1)&ЕСЛИ(-ПСТР(ТЕКСТ(A3;n0);4;3);"миллион"&ВПР(ПСТР(ТЕКСТ(A3;n0);6;1)*И(ПСТР(ТЕКСТ(A3;n0);5;1)-1);мил;2);"")&ИНДЕКС(n_4;ПСТР(ТЕКСТ(A3;n0);7;1)+1)&ИНДЕКС(n1x;ПСТР(ТЕКСТ(A3;n0);8;1)+1;ПСТР(ТЕКСТ(A3;n0);9;1)+1)&ЕСЛИ(-ПСТР(ТЕКСТ(A3;n0);7;3);ВПР(ПСТР(ТЕКСТ(A3;n0);9;1)*И(ПСТР(ТЕКСТ(A3;n0);8;1)-1);тыс;2);"")&ИНДЕКС(n_4;ПСТР(ТЕКСТ(A3;n0);10;1)+1)&ИНДЕКС(n0x;ПСТР(ТЕКСТ(A3;n0);11;1)+1;ПСТР(ТЕКСТ(A3;n0);12;1)+1));"z";" ")&ЕСЛИ(ОТБР(ТЕКСТ(A3;n0));"";"Ноль ")&"рубл"&ВПР(ОСТАТ(МАКС(ОСТАТ(ПСТР(ТЕКСТ(A3;n0);11;2)-11;100);9);10);{0;"ь ":1;"я ":4;"ей "};2)&ПРАВСИМВ(ТЕКСТ(A3;n0);2)&" копе"&ВПР(ОСТАТ(МАКС(ОСТАТ(ПРАВСИМВ(ТЕКСТ(A3;n0);2)-11;100);9);10);{0;"йка":1;"йки":4;"ек"};2)

Так оно попрще будет

0   Спам
4    iasmer   (12.10.2013 10:12)
   "попрще будет" - Гисер, вы забыли к формуле показать именованные области с их содержимым и доп. формулами.

0   Спам
5    kvadimod   (16.02.2014 19:55)
   Классно! Но действительно не работает как писал МСН в п.3. Можно пожалуйста поправить и если можно как вариант адаптировать под денежные циферки hands

Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2016 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!