Stránka 1 z 3

Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 18. 6. 2008 13:32
od d4d1k
Ahojky, řeším jeden problém v excelu a sice jestli umí převést číslo na slovní vyjádření.
Potřeboval bych, aby k číslu zapsanému v jedné buňce jako číslo se automaticky vytvářelo jeho slovní vyjádření ve druhé buňce.

Příklad: A1= 253
B1= dvěstěpadesáttři

Pokud změním číslo v buňce A1, změní se i slovní vyjádření příslušného čísla v buňce B1.

Existuje na to v Excelu nějaká funkce? Já jsem na to bohužel nepřišel.
Pokud mi někdo poradíte, budu velmi vděčný.

Díky moc

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 18. 6. 2008 13:50
od Marek Lutonský
Funkce na tohle neexistuje. Vzhledem k tomu, že čeština skloňuje a v různých případech mají číslovky různé tvary, bylo by asi docela komplikované něco takového vytvořit. Určitě by to ale šlo.

Resp. v jakém rozsahu se ta čísla pohybují? Jaké je nejmenší a největší možné? Jestli jich není moc, tak by se jednoduše v druhém listu ke každému číslu napsalo jeho slovní vyjádření a funkcí Svyhledat by se k číselnému vyjádření hledalo příslušné slovo.

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 18. 6. 2008 17:52
od obcasny_navstevnik
funkce ve VBA pro prevod na slovni vyjadreni, vlozit do modulu, pak ve vlastnich funkcich.

pripadne uprav - odstran mezery (forum nejak v retezcich mrsi diakritiku):

Function Slovy(Cis As Double) As String
Dim StrCis As String
Dim LenCis As Byte, Rad As Integer, Ofs As Byte
Dim Pol As Byte, pom As String, pom1 As String, pom2 As String
Dim Jedn As Variant, Des1 As Variant, Des As Variant, Sta As Variant
Dim JednTM As Variant, Tis As Variant, Mil As Variant
'
If IsEmpty(Cis) Then End
'
Jedn = Array("", "jedna", "dvì", "tøi", "ètyøi", _
"pìt", "šest", "sedm", "osm", "devìt")
Des1 = Array("deset", "jedenáct", "dvanáct", "tøináct", "ètrnáct", _
"patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")
Des = Array("", "", "dvacet ", "tøicet ", "ètyøicet ", "padesát ", _
"šedesát ", "sedmdesát ", "osmdesát ", "devadesát ")
Sta = Array("", "jedno sto ", "dva sta ", "tøi sta ", "ètyøi sta ", _
"pìt set ", "šest set ", "sedm set ", "osm set ", "devìt set ")
Tis = Array("tisíc ", "tisíc ", "tisíce ", "tisíce ", "tisíce ", _
"tisíc ", "tisíc ", "tisíc ", "tisíc ", "tisíc ")
JednTM = Array("", "jeden ", "dva ", "tøi ", "ètyøi ", _
"pìt ", "šest ", "sedm ", "osm ", "devìt ")
Mil = Array("milionù ", "milion ", "miliony ", "miliony ", "miliony ", _
"milionù ", "milionù ", "milionù ", "milionù ", "milionù ")
'
'
StrCis = CStr(Format(Cis, "0.00"))
Pol = InStr(StrCis, ",") - 1 ' poloha radu jednotek v cisle
If Pol > 9 Then Slovy = ">999 999 999": Exit Function
Rad = 0 ' rad cislice v cisle
Slovy = ""
Do
pom = Mid(StrCis, Pol, 1)
If Pol > 1 Then
pom1 = Mid(StrCis, Pol - 1, 1)
Else
pom1 = "0"
End If
'
Select Case Rad
Case 0
pom2 = IIf(pom1 <> 1, Jedn(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
Case 1
pom2 = Des(pom): Ofs = 1
Case 2
pom2 = Sta(pom): Ofs = 1
Case 3
pom2 = IIf(pom1 <> 1, JednTM(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
If Pol > 3 Then ' kdyz zustavaji jeste >3 cislice
If Mid(StrCis, Pol - 2, 3) <> "000" Then
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ") ' a jsou i tisice -> vlozeni slova tisic
Else
Ofs = 3 ' preskoci na rad 6 - miliony
End If
Else ' kdyz zustava jeste <3 cislice -> vlozeni slova tisic
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ")
End If
Case 4
pom2 = Des(pom): Ofs = 1
Case 5
pom2 = Sta(pom): Ofs = 1
Case 6
pom2 = IIf(pom1 <> 1, JednTM(pom) & Mil(pom), Des1(pom) & " milionù "): Ofs = IIf(pom1 <> 1, 1, 2)
Case 7
pom2 = Des(pom): Ofs = 1
Case 8
pom2 = Sta(pom): Ofs = 1
End Select
'
Slovy = pom2 & Slovy
Pol = Pol - Ofs: Rad = Rad + Ofs
'
Loop While Pol > 0
Slovy = Trim(Slovy) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 19. 6. 2008 00:18
od d4d1k
Děkuji moc za pomoc, tohle je přesně to co jsem potřeboval!
Odstranil jsem mezery, opravil diakritiku a teď to šlape jako hodinky (o:

Kdyby to někdo někdy ještě potřeboval, házím upravený kód:

V Excelu na Kartu Vývojář > Visual Basic > Insert > Module (do okna pak vložit text níže)
Funkci vyvoláte přes vlastní funkce nebo zápisem: =slovy(odkaz na buňku s číslem nebo číslo)

Kód: Vybrat vše
Function Slovy(Cis As Double) As String
Dim StrCis As String
Dim LenCis As Byte, Rad As Integer, Ofs As Byte
Dim Pol As Byte, pom As String, pom1 As String, pom2 As String
Dim Jedn As Variant, Des1 As Variant, Des As Variant, Sta As Variant
Dim JednTM As Variant, Tis As Variant, Mil As Variant
'
If IsEmpty(Cis) Then End
'
Jedn = Array("", "jedna", "dvě", "tři", "čtyři", _
"pět", "šest", "sedm", "osm", "devět")
Des1 = Array("deset", "jedenáct", "dvanáct", "třináct", "čtrnáct", _
"patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")
Des = Array("", "", "dvacet", "třicet", "čtyřicet", "padesát", _
"šedesát", "sedmdesát", "osmdesát", "devadesát")
Sta = Array("", "jednosto", "dvěsta", "třista", "čtyřista", _
"pětset", "šestset", "sedmset", "osmset", "devětset")
Tis = Array("tisíc", "tisíc", "tisíce", "tisíce", "tisíce", _
"tisíc", "tisíc", "tisíc", "tisíc", "tisíc")
JednTM = Array("", "jeden", "dva", "tři", "čtyři", _
"pět", "šest", "sedm", "osm", "devět")
Mil = Array("milionů", "milion", "miliony", "miliony", "miliony", _
"milionů", "milionů", "milionů", "milionů", "milionů")
'
'
StrCis = CStr(Format(Cis, "0.00"))
Pol = InStr(StrCis, ",") - 1 ' poloha radu jednotek v cisle
If Pol > 9 Then Slovy = ">999 999 999": Exit Function
Rad = 0 ' rad cislice v cisle
Slovy = ""
Do
pom = Mid(StrCis, Pol, 1)
If Pol > 1 Then
pom1 = Mid(StrCis, Pol - 1, 1)
Else
pom1 = "0"
End If
'
Select Case Rad
Case 0
pom2 = IIf(pom1 <> 1, Jedn(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
Case 1
pom2 = Des(pom): Ofs = 1
Case 2
pom2 = Sta(pom): Ofs = 1
Case 3
pom2 = IIf(pom1 <> 1, JednTM(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
If Pol > 3 Then ' kdyz zustavaji jeste >3 cislice
If Mid(StrCis, Pol - 2, 3) <> "000" Then
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ") ' a jsou i tisice -> vlozeni slova tisic
Else
Ofs = 3 ' preskoci na rad 6 - miliony
End If
Else ' kdyz zustava jeste <3 cislice -> vlozeni slova tisic
pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), " tisíc ")
End If
Case 4
pom2 = Des(pom): Ofs = 1
Case 5
pom2 = Sta(pom): Ofs = 1
Case 6
pom2 = IIf(pom1 <> 1, JednTM(pom) & Mil(pom), Des1(pom) & " milionu` "): Ofs = IIf(pom1 <> 1, 1, 2)
Case 7
pom2 = Des(pom): Ofs = 1
Case 8
pom2 = Sta(pom): Ofs = 1
End Select
'
Slovy = pom2 & Slovy
Pol = Pol - Ofs: Rad = Rad + Ofs
'
Loop While Pol > 0
Slovy = Trim(Slovy) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function


Velké díky obcasny_navstevniku ;-)

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 8. 7. 2008 14:06
od vlkousek
Velké díky oběma. Mám kacířskou otázku, dalo by se něco takového provést i ve Wordu?

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 8. 7. 2008 15:22
od obcasny_navstevnik
nic tomu nebrani, jen tak prvotni navrh a zjednodusene:

Do dokumentu vlozit z ovladacich prvku TextBox.
Vyse uvedenou funkci vlozit v editoru VBA do modulu s upravami:

Function Slovy(Cis As Variant) As String
...
radek:
If IsEmpty(Cis) Then End
nahradit:

If Not IsNumeric(Cis) Then Slovy = "Err": Exit Function

Do objektu MS Word ThisDocument vlozit udalostni proceduru, napr. pro dvojklik na Textbox po vlozeni cisla:
Kód: Vybrat vše
Private Sub TextBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  Selection.EndKey Unit:=wdLine
Selection.TypeText Text:=vbTab & Slovy(TextBox1.Value)
End Sub


a upravit ji do pozadovane podoby.

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 11. 7. 2008 21:07
od vlkousek
Díky moc. Jsi fakt machr, Občasný návštěvníku.

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 14. 9. 2008 20:00
od neveceral
jsem amatér, umím si pouze nahrát makro :potichu , nešlo by vysvětlit i pro mě, jak na to? Nešlo by to upravit, že by se označilo číslo a přes "nějaké" tlačítko se číslo převedlo na text? Díky.

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 15. 9. 2008 10:48
od obcasny_navstevnik
do dokumentu v editoru VBA vloz do modulu nasledujici:

Kód: Vybrat vše
Option Explicit

Sub Prevod()
Dim txt As String

txt = Selection.Text
If IsNumeric(txt) Then MsgBox Slovy1(txt)
End Sub

Function Slovy1(Cis) As String
Dim StrCis As String
Dim LenCis As Byte, Rad As Integer, Ofs As Byte
Dim Pol As Byte, pom As String, pom1 As String, pom2 As String
Dim Jedn As Variant, Des1 As Variant, Des As Variant, Sta As Variant
Dim JednTM As Variant, Tis As Variant, Mil As Variant
'
  If Not IsNumeric(Cis) Then Slovy1 = "Hodnota není číslo!": Exit Function
  If Cis > 999999999 Then Slovy1 = "Hodnota>999 999 999!": Exit Function
'
  Jedn = Array("", "jedna", "dvě", "tři", "čtyři", _
    "pět", "šest", "sedm", "osm", "devět")
  Des1 = Array("deset", "jedenáct", "dvanáct", "třináct", "čtrnáct", _
    "patnáct", "šestnáct", "sedmnáct", "osmnáct", "devatenáct")
  Des = Array("", "", "dvacet", "třicet", "čtyřicet", "padesát", _
    "šedesát", "sedmdesát", "osmdesát", "devadesát")
  Sta = Array("", "jednosto", "dvasta", "třista", "čtyřista", _
    "pětset", "šestset", "sedmset", "osmset", "devětset")
  Tis = Array("tisíc", "tisíc", "tisíce", "tisíce", "tisíce", _
    "tisíc", "tisíc", "tisíc", "tisíc", "tisíc")
  JednTM = Array("", "jeden", "dva", "tři", "čtyři", _
    "pět", "šest", "sedm", "osm", "devět")
  Mil = Array("milionů", "milion", "miliony", "miliony", "miliony", _
  "milionů", "milionů", "milionů", "milionů", "milionů")
'
'
  StrCis = CStr(Format(Cis, "0.00"))
  Pol = InStr(StrCis, ",") - 1 ' poloha radu jednotek v cisle
  Rad = 0 ' rad cislice v cisle
  Slovy1 = ""
  Do
    pom = Mid(StrCis, Pol, 1)
    If Pol > 1 Then
      pom1 = Mid(StrCis, Pol - 1, 1)
    Else
      pom1 = "0"
    End If
'
    Select Case Rad
      Case 0
        pom2 = IIf(pom1 <> 1, Jedn(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
      Case 1
        pom2 = Des(pom): Ofs = 1
      Case 2
        pom2 = Sta(pom): Ofs = 1
      Case 3
        pom2 = IIf(pom1 <> 1, JednTM(pom), Des1(pom)): Ofs = IIf(pom1 <> 1, 1, 2)
        If Pol > 3 Then ' kdyz zustavaji jeste >3 cislice
          If Mid(StrCis, Pol - 2, 3) <> "000" Then
            pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), "tisíc") ' a jsou i tisice -> vlozeni slova tisic
          Else
            Ofs = 3 ' preskoci na rad 6 - miliony
          End If
        Else ' kdyz zustava jeste <3 cislice -> vlozeni slova tisic
          pom2 = pom2 & IIf(pom1 <> 1, Tis(pom), "tisíc")
        End If
      Case 4
        pom2 = Des(pom): Ofs = 1
      Case 5
        pom2 = Sta(pom): Ofs = 1
      Case 6
        pom2 = IIf(pom1 <> 1, JednTM(pom) & Mil(pom), Des1(pom) & "milionů"): Ofs = IIf(pom1 <> 1, 1, 2)
      Case 7
        pom2 = Des(pom): Ofs = 1
      Case 8
        pom2 = Sta(pom): Ofs = 1
    End Select
'
    Slovy1 = pom2 & Slovy1
    Pol = Pol - Ofs: Rad = Rad + Ofs
'
  Loop While Pol > 0
  Slovy1 = Trim(Slovy1) ' & " " & Right(StrCis, 2) ' pridani destinne casti
End Function


subrutine Prevod (uprav si dle potreby) prirad klavesovou zkratku (postup v napovede)
vyber cislo, stiskni klavesovou zkratku

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 15. 9. 2008 20:39
od neveceral
super, děkuji, má to ale malou chybku, číslo slovy se nenapíše do dokumentu, ale pouze se rozbrazí ve zprávě
http://img225.imageshack.us/my.php?image=beznzvuxi6.jpg

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 15. 9. 2008 22:01
od obcasny_navstevnik
to je tak velky problem upravit subrutinu?

Kód: Vybrat vše
Sub Prevod()
Dim txt As String
  txt = Selection.Text
  If IsNumeric(txt) Then
    'MsgBox Slovy1(txt)
    Selection.MoveRight
    Selection.TypeText "  " & Slovy1(txt)
  End If
End Sub

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 15. 9. 2008 22:19
od neveceral
velmi děkuji, bohužel, problém to pro mě je, protože jsem sotva pochopil, že problém je msgbox, mé schopnosti končí v nahrání makra, max. v jeho lehké úpravě. Ještě jednou velmi děkuji.

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 31. 1. 2009 23:21
od jambo1109
Díky moc za pomoc, funguje i v Accessu, ušetří mi to spoustu práce.
Hezký den. ;-)

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 26. 4. 2009 20:51
od ByTrit
Zdravim mam mensi problem pri vacsich cislach (ako su miliony) sa pokazi sklonovanie cisloviek (napr z cisla 22milionov to spravi 22miliony co je blbost)
vo VBA som kedysi robil ale to je davno (asi 5 rokov dozadu) nasiel by sa niekto kto by vedel opravit toto sklonovanie?

Re: Excel- Převod čísla na slovní vyjádření

Odeslat příspěvekNapsal: 26. 4. 2009 21:14
od fatman
OT:
ByTrit píše:napr z cisla 22milionov to spravi 22miliony co je blbost


Nevím jak ve slovenštině, ale v češtině je to správně - 22 miliony, 21 kilogram (čteno dvacet jeden kilogram - říkáme přeci jeden kilogram a ne jedna kilogramů), nicméně je povolen i tvar dvacetjedna kilogramů a korektní tvar 21 kilogram začíná být chápan jako zastaralý.