Jak převést čísla na slova v indických rupiích v aplikaci Excel?
V tomto článku představím, jak převést seznam čísel na slova v indických rupiích nebo anglickém dolaru v aplikaci Excel.
Převádějte čísla na slova v indických rupiích pomocí kódu VBA
Převod čísel na slova v anglickém dolaru s úžasnou funkcí
Převádějte čísla na slova v indických rupiích pomocí kódu VBA
Následující kód VBA vám pomůže převést čísla na slova v rupiích, postupujte takto:
1. Podržte ALT + F11 klávesy pro otevření Microsoft Visual Basic pro aplikace okno.
2, klikněte Vložit > Modula vložte následující kód do okna modulu.
Kód VBA: Převádějte čísla na slova v rupiích
Public Function RupeeFormat(SNum As String)
'Updateby Extendoffice
Dim xDPInt As Integer
Dim xArrPlace As Variant
Dim xRStr_Paisas As String
Dim xNumStr As String
Dim xF As Integer
Dim xTemp As String
Dim xStrTemp As String
Dim xRStr As String
Dim xLp As Integer
xArrPlace = Array("", "", " Thousand ", " Lacs ", " Crores ", " Trillion ", "", "", "", "")
On Error Resume Next
If SNum = "" Then
RupeeFormat = ""
Exit Function
End If
xNumStr = Trim(str(SNum))
If xNumStr = "" Then
RupeeFormat = ""
Exit Function
End If
xRStr = ""
xLp = 0
If (xNumStr > 999999999.99) Then
RupeeFormat = "Digit excced Maximum limit"
Exit Function
End If
xDPInt = InStr(xNumStr, ".")
If xDPInt > 0 Then
If (Len(xNumStr) - xDPInt) = 1 Then
xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1) & "0", 2))
ElseIf (Len(xNumStr) - xDPInt) > 1 Then
xRStr_Paisas = RupeeFormat_GetT(Left(Mid(xNumStr, xDPInt + 1), 2))
End If
xNumStr = Trim(Left(xNumStr, xDPInt - 1))
End If
xF = 1
Do While xNumStr <> ""
If (xF >= 2) Then
xTemp = Right(xNumStr, 2)
Else
If (Len(xNumStr) = 2) Then
xTemp = Right(xNumStr, 2)
ElseIf (Len(xNumStr) = 1) Then
xTemp = Right(xNumStr, 1)
Else
xTemp = Right(xNumStr, 3)
End If
End If
xStrTemp = ""
If Val(xTemp) > 99 Then
xStrTemp = RupeeFormat_GetH(Right(xTemp, 3), xLp)
If Right(Trim(xStrTemp), 3) <> "Lac" Then
xLp = xLp + 1
End If
ElseIf Val(xTemp) <= 99 And Val(xTemp) > 9 Then
xStrTemp = RupeeFormat_GetT(Right(xTemp, 2))
ElseIf Val(xTemp) < 10 Then
xStrTemp = RupeeFormat_GetD(Right(xTemp, 2))
End If
If xStrTemp <> "" Then
xRStr = xStrTemp & xArrPlace(xF) & xRStr
End If
If xF = 2 Then
If Len(xNumStr) = 1 Then
xNumStr = ""
Else
xNumStr = Left(xNumStr, Len(xNumStr) - 2)
End If
ElseIf xF = 3 Then
If Len(xNumStr) >= 3 Then
xNumStr = Left(xNumStr, Len(xNumStr) - 2)
Else
xNumStr = ""
End If
ElseIf xF = 4 Then
xNumStr = ""
Else
If Len(xNumStr) <= 2 Then
xNumStr = ""
Else
xNumStr = Left(xNumStr, Len(xNumStr) - 3)
End If
End If
xF = xF + 1
Loop
If xRStr = "" Then
xRStr = "No Rupees"
Else
xRStr = " Rupees " & xRStr
End If
If xRStr_Paisas <> "" Then
xRStr_Paisas = " and " & xRStr_Paisas & " Paisas"
End If
RupeeFormat = xRStr & xRStr_Paisas & " Only"
End Function
Function RupeeFormat_GetH(xStrH As String, xLp As Integer)
Dim xRStr As String
If Val(xStrH) < 1 Then
RupeeFormat_GetH = ""
Exit Function
Else
xStrH = Right("000" & xStrH, 3)
If Mid(xStrH, 1, 1) <> "0" Then
If (xLp > 0) Then
xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Lac "
Else
xRStr = RupeeFormat_GetD(Mid(xStrH, 1, 1)) & " Hundred "
End If
End If
If Mid(xStrH, 2, 1) <> "0" Then
xRStr = xRStr & RupeeFormat_GetT(Mid(xStrH, 2))
Else
xRStr = xRStr & RupeeFormat_GetD(Mid(xStrH, 3))
End If
End If
RupeeFormat_GetH = xRStr
End Function
Function RupeeFormat_GetT(xTStr As String)
Dim xTArr1 As Variant
Dim xTArr2 As Variant
Dim xRStr As String
xTArr1 = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
xTArr2 = Array("", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
Result = ""
If Val(Left(xTStr, 1)) = 1 Then
xRStr = xTArr1(Val(Mid(xTStr, 2, 1)))
Else
If Val(Left(xTStr, 1)) > 0 Then
xRStr = xTArr2(Val(Left(xTStr, 1)) - 1)
End If
xRStr = xRStr & RupeeFormat_GetD(Right(xTStr, 1))
End If
RupeeFormat_GetT = xRStr
End Function
Function RupeeFormat_GetD(xDStr As String)
Dim xArr_1() As Variant
xArr_1 = Array(" One", " Two", " Three", " Four", " Five", " Six", " Seven", " Eight", " Nine", "")
If Val(xDStr) > 0 Then
RupeeFormat_GetD = xArr_1(Val(xDStr) - 1)
Else
RupeeFormat_GetD = ""
End If
End Function
3. Po vložení kódu uložte a zavřete okno s kódem, vraťte se do listu a zadejte tento vzorec: = RupeeFormat (A2) do prázdné buňky a poté přetažením úchytky výplně dolů použijte tento vzorec na jiné buňky, všechna čísla byla vysvětlena v rupiích, viz screenshot:
Převod čísel na slova v anglickém dolaru s úžasnou funkcí
Pokud chcete převést čísla na slova v anglickém dolaru, Kutools pro ExcelJe Čísla na slova Tato funkce vám pomůže rychle a snadno vyřešit tuto práci.
Tip:Použít toto Počet slov funkce, za prvé, měli byste si stáhnout Kutools pro Excela poté tuto funkci rychle a snadno aplikujte.
Po instalaci Kutools pro Excel, udělejte prosím toto:
1. Vyberte seznam čísel, která chcete převést, a klikněte na Kutools > Obsah > Čísla na slova, viz screenshoty:
2. V Čísla na slova měny dialogové okno vyberte angličtina možnost z nabídky Jazyky části a potom klikněte na Ok tlačítko, čísla ve výběru byla převedena na anglická slova měny, viz screenshot:
Klikněte a stáhněte si Kutools pro Excel a bezplatnou zkušební verzi hned teď!
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%
- 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 a uchovávání údajů; Rozdělit obsah buněk; Zkombinujte duplicitní řádky a součet / průměr... 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ší ...
- Oblíbené a rychlé vkládání vzorců„Rozsahy, grafy a obrázky; Šifrovat buňky s heslem; Vytvořte seznam adresátů a posílat e-maily ...
- 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...
- Seskupování kontingenčních tabulek podle číslo týdne, den v týdnu a další ... Zobrazit odemčené, zamčené buňky různými barvami; Zvýrazněte buňky, které mají vzorec / název...
- 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 snižuje stovky kliknutí myší každý den!