Может у кого есть время/желание/необходимые знания добавить склонение рублей и копеек и увеличить до 999 999 999 999.99 Формула работает до 999 999 999.99 без склонения рублей и копеек (2986 символов) Системный разделитель "."
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Упростил формулу до триллиарда (4262 символа) Осталось склонение рублей и копеек допилить + Первая заглавная И у кого есть какие предложения в упрощении кол-ва символов формулы Надо предложить Microsoft для России кол-во значимых символов для расчетов увеличить согласно курса рубля к доллару
Особенности: 1. Без макросов. Пропись реализована формулой с использованием имен. 2. Не привязана к диапазонам, можно легко копировать/переносить, в т.ч. и в другие книги. 3. Работает до 999 млрд. руб. 4. Делает первую букву прописной, остальные строчные. 5. Правильно округляет до целых копеек, даже если копейки дробные. 6. Изменяет окончание в слове "копейка" в соответствии с правилами русского языка, а не просто "коп.". 7. Формула менее 1000 знаков, и спокойно редактируется в 2003 Excel.
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
Код
Public Function копей_ки(n)
Dim nn As Integer
nn = (Fix(n) / 10 - Fix(Fix(n) / 10)) * 10
If n > 9 And n < 21 Then nn = 0
Select Case nn
Case 1
копей_ки = "копейка"
Case 2, 3, 4
копей_ки = "копейки"
Case Else
копей_ки = "копеек"
End Select
End Function
Public Function руб_ль(n)
Dim nn As Integer
nn = (Fix(n) / 10 - Fix(Fix(n) / 10)) * 10
If n > 9 And n < 21 Then nn = 0
Select Case nn
Case 1
руб_ль = "рубль"
Case 2, 3, 4
руб_ль = "рубля"
Case Else
руб_ль = "рублей"
End Select
End Function
Появление LET сразу говорит о наличии других встроенных типа TEXTJOIN а это означает что можно запихнуть туда повторяющиеся части и срастить результирующий текст.
Так же с помощью LET можно однократно использовать массив и заменив ВЫБОР на ИНДЕКС, убрать повторяющиеся части.
в защиту формульного варианта могу отметить, что она будет работать при любых настройках кодовой страницы, хотя для работы с любыми региональными настройками нужно смотреть.