Дробное число прописью в Excel (вывод целых, десятых, сотых, тысячных)

Function ДробноеЧислоПрописью(chislo)
    ' взято здесь: forum .vingrad .ru/act-ST/f-131/t-106328.html#
    On Error Resume Next
    chislo2 = Int(chislo)
    chislo3 = Round((chislo - chislo2), 3)    '-остаток
    LengthChislo = Len(chislo2)    ' - определяем число циклов по целой части
    Start = 0
    tekst = ""
    For x = LengthChislo To 1 Step -1    ' присвоение  порядка числа
        Start = Start + 1    ' начальная  позиция числа для изъятия в циклах
        '<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
        Select Case x
            Case 12    ' - сотни миллиардов
                num = Mid(chislo2, Start, 1) * 100
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = -1    '- не склоняем
                scl2 = ""
            Case 11    ' - десятки миллиардов
                num = Mid(chislo2, Start, 2) * 1
                If num >= 1 And num <= 20 Then    ' - формируем десятки миллиардов за один цикл
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1   '- не склоняем
                    sclonMlrd = Mid(chislo2, Start, 2) * 1
                    If Right(sclonMlrd, 1) * 1 = 0 Then sclonMlrd = 0    ' ситуация, когда склоняемое  кратно 10
                    Start = Start + 1
                    x = x - 1
                Else    ' - формируем десятки миллиардов за 2 цикла
                    num = Mid(chislo2, Start, 1) * 10
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    scl2 = ""
                End If
            Case 10    ' - формируем хвост десятка миллиардов
                num = Mid(chislo2, Start, 1) * 1
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = Mid(chislo2, Start, 1) * 1
                '-------------------------------------------------------

            Case 9    ' - сотни миллионов
                num = Mid(chislo2, Start, 1) * 100
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = -1    '- не склоняем
                scl2 = ""
            Case 8    ' - десятки миллионов
                num = Mid(chislo2, Start, 2) * 1
                If num >= 1 And num <= 20 Then    ' - формируем десятки миллионов за один цикл
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = Mid(chislo2, Start, 2) * 1
                    sclonMlrd = -1    '- не склоняем
                    If Right(sclon1000000, 1) * 1 = 0 Then sclon1000000 = 0    ' ситуация, когда склоняемое  20
                    Start = Start + 1
                    x = x - 1
                Else    ' - формируем десятки миллионов за 2 цикла
                    num = Mid(chislo2, Start, 1) * 10
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    scl2 = ""
                End If
            Case 7    ' - формируем хвост десятка миллионов
                num = Mid(chislo2, Start, 1) * 1
                sclon1000 = -1    '- не склоняем
                sclon1000000 = Mid(chislo2, Start, 1) * 1
                sclonMlrd = -1    '- не склоняем
                '-------------------------------------------------------
            Case 6    ' -  сотни тысяч
                num = Mid(chislo2, Start, 1) * 100
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = -1    '- не склоняем
                scl2 = ""
                If num <> 0 And Mid(chislo2, Start + 1, 1) = "0" _
                   And Mid(chislo2, Start + 2, 1) = "0" _
                   Then    'если ровные сотни,
                    sclon1000 = 0    'то сразу добавляем sclon сотен
                    x = x - 2    ' и перескакиваем через циклы десятков тысяч
                    Start = Start + 2    ' за 2 цикла
                End If
            Case 5    ' - десятки тысяч
                num = Mid(chislo2, Start, 2) * 1
                If (num >= 1 And num <= 20) Or (num <> 0 And Right(num, 1) * 1 = 0) Then    ' - формируем десятки тысяч за один цикл
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    sclon1000 = Mid(chislo2, Start, 2) * 1
                    If Right(sclon1000, 1) * 1 = 0 Then sclon1000 = 0    ' ситуация, когда склоняемое  кратно десяти
                    Start = Start + 1
                    x = x - 1
                Else    ' - формируем десятки тысяч за 2 цикла
                    num = Mid(chislo2, Start, 1) * 10
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    scl2 = ""
                End If

            Case 4    ' - формируем хвост десятка тысяч
                If Mid(chislo2, Start, 1) * 1 = 0 Then  'если десятков тысяч нет то не используем sclon1000
                    num = Mid(chislo2, Start, 1) * 1
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    scl2 = ""
                Else    ' -используем sclon
                    num = Mid(chislo2, Start, 1) * 1
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    sclon1000 = Mid(chislo2, Start, 1) * 1
                End If
                '-------------------------------------------------------
            Case 3    ' - сотни
                num = Mid(chislo2, Start, 1) * 100
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = -1    '- не склоняем
                scl2 = ""
            Case 2    ' - десятки
                num = Mid(chislo2, Start, 2) * 1
                If (num >= 1 And num <= 20) Or (num <> 0 And Right(num, 1) * 1 = 0) Then    ' - формируем десятки  за один цикл
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                    Start = Start + 1
                    x = x - 1
                Else    ' - формируем десятки  за 2 цикла
                    num = Mid(chislo2, Start, 1) * 10
                    sclon1000 = -1    '- не склоняем
                    sclon1000000 = -1    '- не склоняем
                    sclonMlrd = -1    '- не склоняем
                End If
            Case 1    ' - формируем хвост десятка
                num = Mid(chislo2, Start, 1) * 1
                sclon1000 = -1    '- не склоняем
                sclon1000000 = -1    '- не склоняем
                sclonMlrd = -1    '- не склоняем
        End Select
        '-------------------------------------------------------
        Call Chisla(num, txt, x, txt2, chislo3)
        '-------------------------------------------------------
        If sclon1000 <> -1 Then
            Select Case sclon1000
                Case 1
                    scl = "тысяча"
                Case 2 To 4
                    scl = "тысячи"
                Case 5 To 19
                    scl = "тысяч"
                Case 0
                    scl = "тысяч"
            End Select
            scl2 = scl & " "
        End If
        If sclon1000000 <> -1 Then
            Select Case sclon1000000
                Case 1
                    scl = "миллион"
                Case 2 To 4
                    scl = "миллиона"
                Case 5 To 19
                    scl = "миллионов"
                Case 0
                    scl = "миллионов"
            End Select
            scl2 = scl & " "
        End If

        If sclonMlrd <> -1 Then
            Select Case sclonMlrd
                Case 1
                    scl = "миллиард"
                Case 2 To 4
                    scl = "миллиарда"
                Case 5 To 19
                    scl = "миллиардов"
                Case 0
                    scl = "миллиардов"
            End Select
            scl2 = scl & " "
        End If
        tekst = tekst & txt2 & scl2
    Next x
    ' <<<СЧИТАЕМ ДОЛИ, ЕСЛИ они конечно ЕСТЬ <<<
    If (chislo - chislo2) > 0 Then
        If Right(chislo2, 1) = "1" Then
            tekst = tekst & " целая "
        Else: tekst = tekst & " целых "
        End If
 
        LengthChislo = Len(chislo3) - 2
        ' - здесь недомнажаем на 1, т.к. необходим именно тестовый формат для корректной работы с такими числами, как напр. ",003"
        chislo3 = Right(chislo3, LengthChislo)
        Start = 0
        For x = LengthChislo To 1 Step -1    ' присвоение  порядка числа
            Start = Start + 1    ' начальная  позиция числа для изъятия в циклах
            '<<<<<<<<
            Select Case x
                Case 3    ' - тысячные
                    num = Mid(chislo3, Start, 1) * 100
                    sclon1000 = -1
                    sclon100 = -1    '- не склоняем
                    sclon10 = -1
                    scl2 = ""
                Case 2    ' - сотые
                    num = Mid(chislo3, Start, 2) * 1
                    If (num >= 1 And num <= 20) Or (num <> 0 And Right(num, 1) * 1 = 0) Then    ' - формируем десятки  за один цикл
                        If LengthChislo = 3 Then
                            sclon1000 = num
                        Else: sclon1000 = -1
                        End If
                        If LengthChislo = 2 Then
                            sclon100 = num
                        Else: sclon100 = -1    '- не склоняем
                        End If
                        If LengthChislo = 1 Then
                            sclon10 = num
                        Else: sclon10 = -1
                        End If
                        Start = Start + 1
                        x = x - 1
                    Else    ' - формируем десятки  за 2 цикла
                        num = Mid(chislo3, Start, 1) * 10
                        sclon1000 = -1    '- не склоняем
                        sclon100 = -1    '- не склоняем
                        sclon10 = -1    '- не склоняем
                    End If

                Case 1    ' - формируем хвост десятка
                    num = Mid(chislo3, Start, 1) * 1
                    If LengthChislo = 3 Then
                        sclon1000 = num
                    Else: sclon1000 = -1
                    End If
                    If LengthChislo = 2 Then
                        sclon100 = num
                    Else: sclon100 = -1    '- не склоняем
                    End If
                    If LengthChislo = 1 Then
                        sclon10 = num
                    Else: sclon10 = -1
                    End If
            End Select
            '-------------------------------------------------------
            Call Chisla(num, txt, x, txt2, chislo3)
            '-------------------------------------------------------
            If sclon1000 <> -1 Then
                Select Case sclon1000
                    Case 1
                        scl = "тысячная"
                    Case Else
                        scl = "тысячных"
                End Select
                scl2 = scl & " "
            End If
            If sclon100 <> -1 Then
                Select Case sclon100
                    Case 1
                        scl = "сотая"
                    Case Else
                        scl = "сотых"
                End Select
                scl2 = scl & " "
            End If
            If sclon10 <> -1 Then
                Select Case sclon10
                    Case 1
                        scl = "десятая"
                    Case Else
                        scl = "десятых"
                End Select
                scl2 = scl & " "
            End If
            tekst = tekst & txt2 & scl2
        Next x
    End If
    ДробноеЧислоПрописью = tekst
End Function

Sub Chisla(num, txt, x, txt2, chislo3)
    Select Case num
        Case 0
            txt = ""
        Case 1
            txt = "один"
            If x = 4 Or (chislo3 <> 0 And x = 1) Then    ' (если есть дробная часть)
                txt = "одна"
            End If
        Case 2
            txt = "два"
            If x = 4 Or (chislo3 <> 0 And x = 1) Then    ' (если есть дробная часть)
                txt = "две"
            End If
        Case 3
            txt = "три"
        Case 4
            txt = "четыре"
        Case 5
            txt = "пять"
        Case 6
            txt = "шесть"
        Case 7
            txt = "семь"
        Case 8
            txt = "восемь"
        Case 9
            txt = "девять"
        Case 10
            txt = "десять"
        Case 11
            txt = "одиннадцать"
        Case 12
            txt = "двенадцать"
        Case 13
            txt = "тринадцать"
        Case 14
            txt = "четырнадцать"
        Case 15
            txt = "пятнадцать"
        Case 16
            txt = "шестнадцать"
        Case 17
            txt = "семнадцать"
        Case 18
            txt = "восемнадцать"
        Case 19
            txt = "девятнадцать"
        Case 20
            txt = "двадцать"
        Case 30
            txt = "тридцать"
        Case 40
            txt = "сорок"
        Case 50
            txt = "пятьдесят"
        Case 60
            txt = "шестьдесят"
        Case 70
            txt = "семьдесят"
        Case 80
            txt = "восемьдесят"
        Case 90
            txt = "девяносто"
        Case 100
            txt = "сто"
        Case 200
            txt = "двести"
        Case 300
            txt = "триста"
        Case 400
            txt = "четыреста"
        Case 500
            txt = "пятьсот"
        Case 600
            txt = "шестьсот "
        Case 700
            txt = "семьсот"
        Case 800
            txt = "восемсот"
        Case 900
            txt = "девятьсот"
    End Select
    If txt <> "" Then txt2 = txt & " " Else txt2 = txt
End Sub