Note: The other languages of the website are Google-translated. Back to English
English English

Jak rychle převést datum na slova v aplikaci Excel?

Obecně obvykle převedeme datum do jiných formátů data nebo číslic v aplikaci Excel, ale narazili jste někdy na problém s převodem data na anglická slova, jak je zobrazeno níže? Ve skutečnosti neexistuje žádná vestavěná funkce, která by to zvládla, ale kód VBA.
datum dokumentu na slova 1

Převeďte datum na slovo pomocí definované funkce


Převeďte datum na slovo pomocí definované funkce

Zde je kód makra, který vám udělá laskavost při převodu dat na slova.

1. Povolte list, který používáte, a stiskněte Alt + F11 klíče k otevření Microsoft Visual Basic pro aplikace okno.

2. cvaknutí Vložit > Modul a vložte níže uvedený kód do skriptu.

VBA: Převést datum na slovo

Function DateToWords(ByVal xRgVal As Date) As String
'UpdatebyExtendoffice20170926
    Dim xYear As String
    Dim Hundreds As String
    Dim Decades As String
    Dim xTensArr As Variant
    Dim xOrdArr As Variant
    Dim xCardArr As Variant
    xOrdArr = Array("First", "Second", "Third", _
                   "Fourth", "Fifth", "Sixth", _
                   "Seventh", "Eighth", "Nineth", _
                   "Tenth", "Eleventh", "Twelfth", _
                   "Thirteenth", "Fourteenth", _
                   "Fifteenth", "Sixteenth", _
                   "Seventeenth", "Eighteenth", _
                   "Nineteenth", "Twentieth", _
                   "Twenty-first", "Twenty-second", _
                   "Twenty-third", "Twenty-fourth", _
                   "Twenty-fifth", "Twenty-sixth", _
                   "Twenty-seventh", "Twenty-eighth", _
                   "Twenty-nineth", "Thirtieth", _
                   "Thirty-first")
    xCardArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen")
    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")
    xYear = CStr(Year(xRgVal))
    Decades = Mid$(xYear, 3)
    If CInt(Decades) < 20 Then
        Decades = xCardArr(CInt(Decades))
    Else
        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
                xCardArr(CInt(Right$(Decades, 1)))
    End If
        Hundreds = Mid$(xYear, 2, 1)
    If CInt(Hundreds) Then
        Hundreds = xCardArr(CInt(Hundreds)) & " Hundred "
    Else
        Hundreds = ""
    End If
    DateToWords = xOrdArr(Day(xRgVal) - 1) & _
                  Format$(xRgVal, " mmmm ") & _
                  xCardArr(CInt(Left$(xYear, 1))) & _
                  " Thousand " & Hundreds & Decades
End Function

datum dokumentu na slova 2

3. Uložte kód a vraťte se na list, vyberte buňku, do které bude výsledek odeslán, zadejte tento vzorec = DateToWords (A1) (A1 je datum, které používáte), stiskněte vstoupit a přetáhněte rukojeť automatického vyplňování přes buňky, které potřebujete. Viz snímek obrazovky:
datum dokumentu na slova 3


Čísla na slova

doc vysvětlí číslo 1

Relativní články:


Nejlepší kancelářské nástroje produktivity

Kutools pro Excel řeší většinu vašich problémů a zvyšuje vaši produktivitu o 80%

  • Opakované použití: Rychle vložte složité vzorce, grafy a cokoli, co jste dříve používali; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
  • Super Formula Bar (snadno upravit více řádků textu a vzorce); Rozložení pro čtení (snadno číst a upravovat velké množství buněk); Vložit do filtrovaného rozsahu...
  • Sloučit buňky / řádky / sloupce bez ztráty dat; Rozdělit obsah buněk; Zkombinujte duplicitní řádky / sloupce... Zabraňte duplicitním buňkám; Porovnat rozsahy...
  • Vyberte možnost Duplikovat nebo Jedinečný Řádky; Vyberte prázdné řádky (všechny buňky jsou prázdné); Super hledání a fuzzy hledání v mnoha sešitech; Náhodný výběr ...
  • Přesná kopie Více buněk beze změny odkazu na vzorec; Automaticky vytvářet reference do více listů; Vložte odrážky, Zaškrtávací políčka a další ...
  • Extrahujte text, Přidat text, Odebrat podle pozice, Odebrat mezeru; Vytváření a tisk mezisoučtů stránkování; Převod mezi obsahem buněk a komentáři...
  • Super filtr (uložit a použít schémata filtrů na jiné listy); Rozšířené řazení podle měsíce / týdne / dne, frekvence a dalších; Speciální filtr tučnou kurzívou ...
  • Kombinujte sešity a pracovní listy; Sloučit tabulky na základě klíčových sloupců; Rozdělte data do více listů; Dávkový převod xls, xlsx a PDF...
  • Více než 300 výkonných funkcí. Podporuje Office / Excel 2007-2019 a 365. Podporuje všechny jazyky. Snadné nasazení ve vašem podniku nebo organizaci. Kompletní funkce 30denní bezplatná zkušební verze. 60denní záruka vrácení peněz.
karta kte 201905

Office Tab přináší do Office rozhraní s kartami a usnadňuje vám práci

  • Povolte úpravy a čtení na kartách ve Wordu, Excelu, PowerPointu, Publisher, Access, Visio a Project.
  • Otevřete a vytvořte více dokumentů na nových kartách ve stejném okně, nikoli v nových oknech.
  • Zvyšuje vaši produktivitu o 50% a omezuje stovky kliknutí myší každý den!
officetab dno
Komentáře (20)
Zatím žádné hodnocení. Buďte první, kdo ohodnotí!
Tento komentář byl moderátorem webu minimalizován
Vzorec datetowords nefunguje ve všech souborech exall
Tento komentář byl moderátorem webu minimalizován
Promiňte, můžete mi říct, který typ souborů aplikace Excel nemůže fungovat?
Tento komentář byl moderátorem webu minimalizován
To po desetiletích nad 20 dává pomlčku, která končí nulou.
Tento komentář byl moderátorem webu minimalizován
Opravena pomlčka za 20, 30, 40 atd.

Přidejte toto za „If CInt(Decades) < 20 Then
Desetiletí = xCardArr(CInt(Dekády))"

ElseIf CInt(Decades) Jako "*0" Pak
Desetiletí = xTensArr(CInt(Left$(Decades, 1)) - 2)
Tento komentář byl moderátorem webu minimalizován
No, jeho práce, pěkná, ale nějaké problémy formátu jsou tady, protože 1975 (Devatenáct tisíc sedmdesát pět) ne (tisíc devět set sedmdesát pět), ale v případě 20+ je formát správný jako 2011 (dva tisíce jedenáct ), a také druhý problém je (jednotné/množné číslo), zde (tisíce, dva tisíce, sto, devět set), vyřešte je prosím, díky
Tento komentář byl moderátorem webu minimalizován
Vynikající...
Tento komentář byl moderátorem webu minimalizován
jeho práce je dobrá, ale chci pro 90. léta "devatenáct set" ne "tisíc devět set"... díky!
Tento komentář byl moderátorem webu minimalizován
Promiň, zia khane, nechápu, co myslíš tím převodem 90 na devatenáct set. VBA umí převádět pouze datum na slova, nástroj Split Out Number převádí čísla na anglická měnová slova
Tento komentář byl moderátorem webu minimalizován
„Nineteen Hundred“ se mluví anglicky, ve skutečnosti je to špatně.
Tento komentář byl moderátorem webu minimalizován
Dobrý den, můžeme to udělat také ve word docx?
Tento komentář byl moderátorem webu minimalizován
datum do slova v jazyce gudžarátštiny k dispozici? prosím odpovězte mi. 9427909038
Tento komentář byl moderátorem webu minimalizován
Myslím, že to nefunguje pro jiné jazyky kromě angličtiny.
Tento komentář byl moderátorem webu minimalizován
jak použít tento kód ve vb6 pro textové pole
Tento komentář byl moderátorem webu minimalizován
Pane paní

Je to pro mě velmi užitečné.

Opravdu úžasné a pomohl vyřešit problém během minuty.

Děkujeme za nahrání tohoto dokumentu. Velmi hezké
Tento komentář byl moderátorem webu minimalizován
děkuji, že mi pomáháš. velmi užitečné při převodu data narození do aplikace word
Tento komentář byl moderátorem webu minimalizován
Chtěl bych k výstupu přidat text, například rok 1958 se převede na tisíc devatenáct set padesát osm a chtěl bych, aby to bylo tisíc devatenáct set a Padesát osm. Může mi prosím někdo dát příklad, jak to mohu udělat?
Tento komentář byl moderátorem webu minimalizován
Dává to #JMÉNO? Chyba
Tento komentář byl moderátorem webu minimalizován
آپ کا بہت شکریہ
Tento komentář byl moderátorem webu minimalizován
07. 08. 1998 XNUMX. SRPEN XNUMX ST devadesát osm
Potřebuji dob do slov ve vyšším formátu, ale používám tento mikros v excelu, mám to
07 08. SRPEN TISÍC DEVĚT ST devadesát osm, což není užitečné
Tento komentář byl moderátorem webu minimalizován
Ahoj, MAX, upravil jsem VBA, zkuste mi prosím vědět, jestli to funguje. Dík.
Function DateToWords(ByVal xRgVal As Date) As String
'UpdatebyExtendoffice20170926
    Dim xYear As String
    Dim Decades As String
    Dim years As String
    Dim xTensArr As Variant
    Dim xyearArr As Variant
    Dim xOrdArr As Variant
    Dim xCardArr As Variant
    xOrdArr = Array("First", "Second", "Third", _
                   "Fourth", "Fifth", "Sixth", _
                   "Seventh", "Eighth", "Nineth", _
                   "Tenth", "Eleventh", "Twelfth", _
                   "Thirteenth", "Fourteenth", _
                   "Fifteenth", "Sixteenth", _
                   "Seventeenth", "Eighteenth", _
                   "Nineteenth", "Twentieth", _
                   "Twenty-first", "Twenty-second", _
                   "Twenty-third", "Twenty-fourth", _
                   "Twenty-fifth", "Twenty-sixth", _
                   "Twenty-seventh", "Twenty-eighth", _
                   "Twenty-nineth", "Thirtieth", _
                   "Thirty-first")
    xCardArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen")
    xTensArr = Array("Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")
    xYear = CStr(Year(xRgVal))
    
    
      xyearArr = Array("", "One", "Two", "Three", "Four", _
                   "Five", "Six", "Seven", "Eight", "Nine", _
                   "Ten", "Eleven", "Twelve", "Thirteen", _
                   "Fourteen", "Fifteen", "Sixteen", _
                   "Seventeen", "Eighteen", "Nineteen", "Twenty", "Thirty", "Forty", "Fifty", _
               "Sixty", "Seventy", "Eighty", "Ninety")

    years = xyearArr(CInt(Year(xRgVal) / 100)) & " Hundred"
    
    Decades = Mid$(xYear, 3)
    If CInt(Decades) < 20 Then
        Decades = xCardArr(CInt(Decades))
    Else
        Decades = xTensArr(CInt(Left$(Decades, 1)) - 2) & "-" & _
                xCardArr(CInt(Right$(Decades, 1)))
    End If

    DateToWords = UCase(xOrdArr(Day(xRgVal) - 1) & _
                  Format$(xRgVal, " mmmm ") & _
                  years & " " & Decades)
End Function

Zatím zde nejsou žádné komentáře
Zanechat své připomínky
Odesílání jako host
×
Ohodnoťte tento příspěvek:
0   Postavy
Doporučená umístění