Přidat otázku mezi oblíbenéZasílat nové odpovědi e-mailemVyřešeno Excel číslo slovy

Function epfCISLOSLOVNE(Cislo As Double, Optional Velke As Boolean = True) As _
    String

    Dim aJednotky
    Dim aDesitky
    Dim aStovky
    Dim aRady
    Dim aRady1
    Dim aRady234

    Dim i As Integer
    Dim iPocet3 As Integer
    Dim iDelka As Integer
    Dim iDelka3 As Integer
    Dim iStovky As Integer
    Dim iDesitkyJednotky As Integer

    Dim strCislo3 As String
    Dim strStovky As String
    Dim strDesitkyJednotky As String
    Dim strCisloText As String
    
    Dim mena As String

    'vynucený přepočet funkce při změně na listu
    Application.Volatile

    'pole pro desítky
    aDesitky = Array("", "deset", "dvacet", "třicet", "čtyřicet", "padesát", _
        "šedesát", "sedmdesát", "osmdesát", "devadesát")

    'pole pro jednotky
    aJednotky = Array("", "jedna", "dva", "tři", "čtyři", "pět", "šest", "sedm", _
        "osm", "devět", "deset", "jedenáct", "dvanáct", "třináct", "čtrnáct", _
        "patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")

    'pole pro stovky
    aStovky = Array("", "sto", "dvěstě", "třista", "čtyřista", "pětset", _
        "šestset", "sedmset", "osmset", "devětset")

    'pole pro řády
    aRady = Array("", "tisíc", "milionů", "miliard")
    aRady1 = Array("", "tisíc", "milion", "miliarda")
    aRady234 = Array("", "tisíce", "miliony", "miliardy")

    'skutečná délka čísla
    iDelka = Len(CStr(Cislo))
    'délka čísla po zaokrouhlení na trojice nahoru
    iDelka3 = WorksheetFunction.Ceiling(iDelka, 3)
    'číslo formátované do trojic
    strCislo3 = Format(Cislo, String(iDelka3, "0"))
    'počet trojic
    iPocet3 = iDelka3 \ 3

    'pro všechny trojice
    For i = 1 To iPocet3

        'reset proměnných
        strStovky = ""
        strDesitkyJednotky = ""
        strRady = ""

        'počet stovek
        iStovky = Val(Mid(strCislo3, 3 * i - 2, 1))
        'počet desítek a jednotek
        iDesitkyJednotky = Val(Mid(strCislo3, 3 * i - 1, 2))

        'a) bez ošetření "jednosto"
        'strStovky = aStovky(iStovky + 1)

        'b) s ošetřením "jednosto"
        'If iStovky = 1 And i = 1 Then
        If iStovky = 1 Then
            strStovky = "jedno" & aStovky(iStovky + 1)
        Else
            strStovky = aStovky(iStovky + 1)
        End If

        'rozlišení desítek a jednotek
        Select Case iDesitkyJednotky
            Case 0
                If iStovky = 0 Then
                    If iPocet3 = 1 Then
                        strDesitkyJednotky = "nula"
                    End If
                Else
                    'text tisíců, milionů, ...
                    strRady = aRady(iPocet3 - i + 1)
                End If
            Case 1
                'výjimka, "jeden" namísto "jedna" z pole
                'pro "jedentisíc", "jedenmilion", ...
                If (iStovky = 0) And (iPocet3 > 1) And (i <> iPocet3) Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "jeden"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady1(iPocet3 - i + 1)
            Case 2
                'výjimka, "dvě" namísto "dva" z pole
                'pro "dvě" (koruny, miliardy)
                If (iStovky = 0 And iPocet3 = 1) Or (iStovky = 0 And iPocet3 = _
                    4) Then
                    'text desítek a jednotek
                    strDesitkyJednotky = "dvě"
                Else
                    'text desítek a jednotek
                    strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                End If
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 3, 4
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady234(iPocet3 - i + 1)
            Case 5 To 19
                'text desítek a jednotek
                strDesitkyJednotky = aJednotky(iDesitkyJednotky + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
            Case Is >= 20
                'text desítek a jednotek
                strDesitkyJednotky = aDesitky((iDesitkyJednotky \ 10) + 1) & _
                    aJednotky((iDesitkyJednotky Mod 10) + 1)
                'text tisíců, milionů, ...
                strRady = aRady(iPocet3 - i + 1)
        End Select

        strCisloText = strCisloText & strStovky & strDesitkyJednotky & strRady

    Next i

                Select Case Cislo
                    Case 2 To 4
                        mena = " Eura"
                    Case Else
                        mena = " Euro"
                End Select




    epfCISLOSLOVNE = IIf(Velke, UCase(Left$(strCisloText, 1)) & _
        Mid$(strCisloText, 2), strCisloText) & mena

End Function

Reakce na odpověď

1 Zadajte svou přezdívku:
2 Napište svou odpověď:
3 Pokud chcete dostat ban, zadejte libovolný text:

Zpět do poradny