Как преобразовать числа в слова в индийских рупиях в Excel?
Преобразование чисел в слова является распространённым требованием, особенно при подготовке финансовых документов, таких как счета-фактуры или чеки. Хотя в Excel нет встроенной функции для преобразования чисел в слова, это можно сделать с помощью VBA. Вот пошаговое руководство по преобразованию чисел в слова в индийских рупиях или другой валюте.
Преобразование чисел в слова в индийских рупиях с помощью кода VBA
Преобразование чисел в слова в индийских рупиях с помощью кода VBA
Следующий код VBA поможет вам преобразовать числа в слова в рупиях, выполните следующие действия:
1. Нажмите и удерживайте клавиши "ALT" + "F11", чтобы открыть окно "Microsoft Visual Basic for Applications".
2. Нажмите "Вставить" → "Модуль" и вставьте следующий код в окно "Модуль".
Код VBA: Преобразование чисел в слова в рупиях
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. После вставки кода сохраните и закройте окно кода, вернитесь на лист и введите следующую формулу в пустую ячейку, затем перетащите маркер заполнения вниз, чтобы применить эту формулу к другим ячейкам — все числа будут преобразованы в слова в рупиях.
=RupeeFormat(A2)
Преобразование чисел в слова на английском языке (доллары) или в другой валюте с удивительной функцией
Упростите задачи в Excel и повысьте свою продуктивность с помощью "Kutools for Excel". "Kutools for Excel" предлагает мощную функцию — "Numbers to Words", которая предоставляет более 40 вариантов конвертации валют, помогая быстро преобразовывать числа в китайские ЮАНЬ, английские доллары или любые другие валютные слова всего за несколько кликов.
После установки Kutools for Excel выполните следующие действия:
1. Выберите список чисел, которые вы хотите преобразовать, затем нажмите "Kutools" → "Текст" → "Numbers to Words".
2. В диалоговом окне "Numbers to Currency Words" выберите один из вариантов валюты в разделе "Язык", см. скриншот:
3. Затем нажмите кнопку "OK", и числа в выделенном диапазоне будут преобразованы в нужные вам валютные слова.
Нажмите, чтобы скачать Kutools for Excel и начать бесплатную пробную версию прямо сейчас!
Лучшие инструменты для повышения производительности Office
Kutools для Excel решает большинство ваших проблем и увеличивает вашу продуктивность на 80%
- Супер строка формул (легкое редактирование нескольких строк текста и формул); Режим чтения (удобное чтение и редактирование большого количества ячеек); Вставка в отфильтрованный диапазон...
- Объединение ячеек/строк/столбцов с сохранением данных; Разделение содержимого ячеек; Объединение дублирующихся строк с подсчетом суммы/среднего значения... Предотвращение дублирования ячеек; Сравнение диапазонов...
- Выбор дублирующихся или уникальных строк; Выбор пустых строк (все ячейки пустые); Супер поиск и нечеткий поиск во многих книгах; Случайный выбор...
- Точное копирование нескольких ячеек без изменения ссылок на формулы; Автоматическое создание ссылок на несколько листов; Вставка маркеров, флажков и многое другое...
- Избранные и быстрая вставка формул, диапазонов, диаграмм и изображений; Шифрование ячеек с паролем; Создание списка рассылки и отправка электронных писем...
- Извлечение текста, добавление текста, удаление по позиции, удаление пробелов; Создание и печать статистики страниц; Преобразование между содержимым ячеек и комментариями...
- Супер фильтр (сохранение и применение схем фильтрации к другим листам); Расширенная сортировка по месяцу/неделе/дню, частоте и другим параметрам; Специальный фильтр по жирному шрифту, курсиву...
- Объединение книг и листов; Объединение таблиц на основе ключевых столбцов; Разделение данных на несколько листов; Пакетное преобразование xls, xlsx и PDF...
- Группировка сводной таблицы по номеру недели, дню недели и другим параметрам... Отображение разблокированных, заблокированных ячеек разными цветами; Выделение ячеек, содержащих формулы/имена...
- Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Publisher, Access, Visio и Project.
- Открывайте и создавайте несколько документов в новых вкладках одного окна, а не в новых окнах.
- Увеличивает вашу продуктивность на 50% и экономит сотни кликов мышью каждый день!
