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

Как преобразовать числа в слова в индийских рупиях в Excel?

В этой статье я расскажу, как преобразовать список чисел в слова в индийских рупиях или английском долларе в Excel.

Преобразование чисел в слова в индийских рупиях с кодом VBA

Преобразование чисел в слова в английском долларе с помощью удивительной функции


Преобразование чисел в слова в индийских рупиях с кодом VBA

Следующий код VBA может помочь вам преобразовать числа в слова в рупиях, пожалуйста, сделайте следующее:

1. Удерживайте ALT + F11 , чтобы открыть Microsoft Visual Basic для приложений окно.

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. После вставки кода сохраните и закройте окно кода, вернитесь на рабочий лист и введите эту формулу: = Формат рупии (A2) в пустую ячейку, а затем перетащите маркер заполнения вниз, чтобы применить эту формулу к другим ячейкам, все числа были записаны в рупиях, см. снимок экрана:


Преобразование чисел в слова в английском долларе с помощью удивительной функции

Если вы хотите преобразовать числа в слова в английском долларе, Kutools for ExcelАвтора Числа в слова функция может помочь вам решить эту задачу быстро и легко.

Советы:Чтобы применить это Число в слова функция, во-первых, вы должны скачать Kutools for Excel, а затем быстро и легко примените эту функцию.

После установки Kutools for Excel, пожалуйста, сделайте так:

1. Выберите список чисел, которые вы хотите преобразовать, и нажмите Кутулс > Содержание > Числа в слова, смотрите скриншоты:

2. В Числа в денежные слова диалоговое окно, выберите Английский из файла Языки раздел, а затем щелкните Ok кнопки, числа в выделении были преобразованы в слова английской валюты, см. снимок экрана:

Нажмите, чтобы загрузить Kutools for Excel и бесплатную пробную версию сейчас!

 


  • Бар Супер Формулы (легко редактировать несколько строк текста и формул); Макет для чтения (легко читать и редактировать большое количество ячеек); Вставить в отфильтрованный диапазон...
  • Объединить ячейки / строки / столбцы и хранение данных; Разделить содержимое ячеек; Объедините повторяющиеся строки и сумму / среднее значение... Предотвращение дублирования ячеек; Сравнить диапазоны...
  • Выберите Дубликат или Уникальный Ряды; Выбрать пустые строки (все ячейки пустые); Супер находка и нечеткая находка во многих рабочих тетрадях; Случайный выбор ...
  • Точная копия Несколько ячеек без изменения ссылки на формулу; Автоматическое создание ссылок на несколько листов; Вставить пули, Флажки и многое другое ...
  • Избранные и быстро вставляйте формулы, Диапазоны, диаграммы и изображения; Зашифровать ячейки с паролем; Создать список рассылки и отправлять электронные письма ...
  • Извлечь текст, Добавить текст, Удалить по позиции, Удалить пробел; Создание и печать промежуточных итогов по страницам; Преобразование содержимого ячеек в комментарии...
  • Суперфильтр (сохранять и применять схемы фильтров к другим листам); Расширенная сортировка по месяцам / неделям / дням, периодичности и др .; Специальный фильтр жирным, курсивом ...
  • Комбинируйте книги и рабочие листы; Объединить таблицы на основе ключевых столбцов; Разделить данные на несколько листов; Пакетное преобразование xls, xlsx и PDF...
  • Группировка сводной таблицы по номер недели, день недели и другое ... Показать разблокированные, заблокированные ячейки разными цветами; Выделите ячейки, у которых есть формула / имя...
вкладка kte 201905
  • Включение редактирования и чтения с вкладками в Word, Excel, PowerPoint, Издатель, доступ, Visio и проект.
  • Открывайте и создавайте несколько документов на новых вкладках одного окна, а не в новых окнах.
  • Повышает вашу продуктивность на 50% и сокращает количество щелчков мышью на сотни каждый день!
офисный дно

 

Сортировать комментарии по
Комментарии (22)
Оценок пока нет. Оцените первым!
Этот комментарий был сведен к минимуму модератором на сайте
Excel аварийно завершает работу, когда эталонная ячейка не имеет клапана!
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Пользователь,
Спасибо за ваш комментарий, код в этой статье был обновлен, попробуйте еще раз, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемые господа,

Добрый день,

Я проверил приведенную выше формулу, она не работает в значениях дефиса минус, таких как -100 -10,000 100 или (10,000) (XNUMX XNUMX)

Сэр, я использую приведенный ниже код в течение последних 1 года, и сегодня я обнаружил ту же ошибку.

Когда я пишу минус -10,000 10,000 или (XNUMX XNUMX), отображается «Всего сто десять тысяч».
Когда я пишу «Положительные 10,000 XNUMX», это прекрасно работает «Только десять тысяч».

Пример ниже:

(10,000.99 99) Всего сто десять тысяч и 100/XNUMX риалов
10,000.99 99 всего десять тысяч и 100/XNUMX риалов
(10,000,000.99 99 100) Всего сто десять миллионов и XNUMX/XNUMX риалов
10,000,000.99 99 100 всего десять миллионов и XNUMX/XNUMX риалов
(10,000,000,000.99 99 100 XNUMX) Всего сто десять миллиардов и XNUMX/XNUMX риалов
10,000,000,000.99 99 100 XNUMX всего десять миллиардов и XNUMX/XNUMX риалов
(10,000,000,000,000.90 90 100 XNUMX XNUMX) Всего сто десять триллионов и XNUMX/XNUMX риалов
10,000,000,000,000.90 90 100 XNUMX XNUMX Всего десять триллионов и XNUMX/XNUMX риалов

Формула = правописание

МОЙ КОД VBA:

'Основная функция
Функция SpellBilling(ByVal MyNumber)
Дим Риал, Халала, Темп
Dim DecimalPlace, граф
ReDim Place(9) как строка
Место(2) = "Тысяча"
Место (3) = "Миллион"
Место (4) = "Миллиард"
Место (5) = "Триллион"
' Строковое представление суммы.
МойЧисло = Обрезать(Стр(МойЧисло))
' Позиция десятичного знака 0, если нет.
DecimalPlace = InStr(MyNumber, ".")
' Преобразуйте Halalas и установите MyNumber на сумму в риалах.
Если Десятичный Разряд > 0 Тогда
Halalas = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim (Left (MyNumber, DecimalPlace - 1))
End If
Count = 1
Делать пока MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
Если Temp <> "" Тогда риалы = Temp & Place(Count) & Riyals
Если Лен(МойЧисло) > 3 Тогда
МойЧисло = Слева(МойЧисло, Лен(МойЧисло) - 3)
Еще
МойНомер = ""
End If
Count = Count + 1
Петля
Выберите кейс риалы
Случай ""
Риалы = "Нет риалов"
Дело «Один»
Риалы = "Только один риал"
Case Else
Риалы = «Только» и риалы
Риалы = риалы и ""
End Select
Выберите кейс Халалас
Случай ""
Halalas = "& 00/00 риалов"
Дело «Один»
Halalas = "& 01/100 риалов"
Дело «Двое»
Halalas = "& 02/100 риалов"
Дело «Три»
Halalas = "& 03/100 риалов"
Дело «Четыре»
Halalas = "& 04/100 риалов"
Дело «Пять»
Halalas = "& 05/100 риалов"
Корпус "Шесть"
Halalas = "& 06/100 риалов"
Дело "Семь"
Halalas = "& 07/100 риалов"
Дело «Восемь»
Halalas = "& 08/100 риалов"
Дело «Девять»
Halalas = "& 09/100 риалов"
Дело «Десятка»
Halalas = "& 10/100 риалов"
Дело «Одиннадцать»
Halalas = "& 11/100 риалов"
Дело «Двенадцать»
Halalas = "& 12/100 риалов"
Дело «Тринадцать»
Halalas = "& 13/100 риалов"
Дело «Четырнадцать»
Halalas = "& 14/100 риалов"
Дело «Пятнадцать»
Halalas = "& 15/100 риалов"
Дело «Шестнадцать»
Halalas = "& 16/100 риалов"
Дело «Семнадцать»
Halalas = "& 17/100 риалов"
Дело «Восемнадцать»
Halalas = "& 18/100 риалов"
Дело «Девятнадцать»
Halalas = "& 19/100 риалов"
Дело «Двадцать»
Halalas = "& 20/100 риалов"
Кейс «Двадцать одно»
Halalas = "& 21/100 риалов"
Кейс «Двадцать два»
Halalas = "& 22/100 риалов"
Кейс «Двадцать три»
Halalas = "& 23/100 риалов"
Кейс «Двадцать четыре»
Halalas = "& 24/100 риалов"
Кейс «Двадцать пять»
Halalas = "& 25/100 риалов"
Кейс «Двадцать шесть»
Halalas = "& 26/100 риалов"
Кейс "Двадцать семь"
Halalas = "& 27/100 риалов"
Дело «Двадцать восемь»
Halalas = "& 28/100 риалов"
Кейс "Двадцать девять"
Halalas = "& 29/100 риалов"
Дело «Тридцать».
Halalas = "& 30/100 риалов"
Дело «Тридцать первое»
Halalas = "& 31/100 риалов"
Дело «Тридцать два»
Halalas = "& 32/100 риалов"
Дело «Тридцать три»
Halalas = "& 33/100 риалов"
Кейс «Тридцать четыре»
Halalas = "& 34/100 риалов"
Дело «Тридцать пять»
Halalas = "& 35/100 риалов"
Кейс «Тридцать шесть»
Halalas = "& 36/100 риалов"
Дело «Тридцать семь»
Halalas = "& 37/100 риалов"
Дело «Тридцать восемь»
Halalas = "& 38/100 риалов"
Кейс «Тридцать девять»
Halalas = "& 39/100 риалов"
Корпус "Сорок"
Halalas = "& 40/100 риалов"
Кейс «Сорок один»
Halalas = "& 41/100 риалов"
Кейс «Сорок два»
Halalas = "& 42/100 риалов"
Дело «Сорок три»
Halalas = "& 43/100 риалов"
Кейс «Сорок четыре»
Halalas = "& 44/100 риалов"
Кейс «Сорок пять»
Halalas = "& 45/100 риалов"
Кейс «Сорок шесть»
Halalas = "& 46/100 риалов"
Кейс «Сорок семь»
Halalas = "& 47/100 риалов"
Дело "Сорок восемь"
Halalas = "& 48/100 риалов"
Кейс "Сорок девять"
Halalas = "& 49/100 риалов"
Кейс "Пятьдесят"
Halalas = "& 50/100 риалов"
Кейс «Пятьдесят один»
Halalas = "& 51/100 риалов"
Дело «Пятьдесят два»
Halalas = "& 52/100 риалов"
Дело «Пятьдесят три»
Halalas = "& 53/100 риалов"
Кейс «Пятьдесят четыре»
Halalas = "& 54/100 риалов"
Кейс "Пятьдесят пять"
Halalas = "& 55/100 риалов"
Кейс «Пятьдесят шесть»
Halalas = "& 56/100 риалов"
Кейс "Пятьдесят семь"
Halalas = "& 57/100 риалов"
Дело "Пятьдесят восемь"
Halalas = "& 58/100 риалов"
Кейс "Пятьдесят девять"
Halalas = "& 59/100 риалов"
Кейс "Шестьдесят"
Halalas = "& 60/100 риалов"
Кейс «Шестьдесят один»
Halalas = "& 61/100 риалов"
Кейс «Шестьдесят два»
Halalas = "& 62/100 риалов"
Кейс «Шестьдесят три»
Halalas = "& 63/100 риалов"
Кейс «Шестьдесят четыре»
Halalas = "& 64/100 риалов"
Кейс «Шестьдесят пять»
Halalas = "& 65/100 риалов"
Кейс «Шестьдесят шесть»
Halalas = "& 66/100 риалов"
Кейс «Шестьдесят семь»
Halalas = "& 67/100 риалов"
Кейс «Шестьдесят восемь»
Halalas = "& 68/100 риалов"
Кейс "Шестьдесят девять"
Halalas = "& 69/100 риалов"
Кейс "Семьдесят"
Halalas = "& 70/100 риалов"
Кейс «Семьдесят один»
Halalas = "& 71/100 риалов"
Дело «Семьдесят два»
Halalas = "& 72/100 риалов"
Кейс «Семьдесят три»
Halalas = "& 73/100 риалов"
Кейс «Семьдесят четыре»
Halalas = "& 74/100 риалов"
Кейс "Семьдесят пять"
Halalas = "& 75/100 риалов"
Кейс «Семьдесят шесть»
Halalas = "& 76/100 риалов"
Кейс "Семьдесят семь"
Halalas = "& 77/100 риалов"
Дело «Семьдесят восемь»
Halalas = "& 78/100 риалов"
Кейс "Семьдесят девять"
Halalas = "& 79/100 риалов"
Дело "Восемьдесят"
Halalas = "& 80/100 риалов"
Кейс «Восемьдесят один»
Halalas = "& 81/100 риалов"
Кейс «Восемьдесят два»
Halalas = "& 82/100 риалов"
Кейс «Восемьдесят три»
Halalas = "& 83/100 риалов"
Кейс «Восемьдесят четыре»
Halalas = "& 84/100 риалов"
Кейс «Восемьдесят пять»
Halalas = "& 85/100 риалов"
Кейс «Восемьдесят шесть»
Halalas = "& 86/100 риалов"
Кейс «Восемьдесят семь»
Halalas = "& 87/100 риалов"
Дело "Восемьдесят восемь"
Halalas = "& 88/100 риалов"
Кейс "Восемьдесят девять"
Halalas = "& 89/100 риалов"
Дело "Девяносто"
Halalas = "& 90/100 риалов"
Кейс «Девяносто один»
Halalas = "& 91/100 риалов"
Дело «Девяносто два»
Halalas = "& 92/100 риалов"
Дело «Девяносто три»
Halalas = "& 93/100 риалов"
Кейс «Девяносто четыре»
Halalas = "& 94/100 риалов"
Дело "Девяносто пять"
Halalas = "& 95/100 риалов"
Кейс «Девяносто шесть»
Halalas = "& 96/100 риалов"
Кейс «Девяносто семь»
Halalas = "& 97/100 риалов"
Дело «Девяносто восемь»
Halalas = "& 98/100 риалов"
Кейс "Девяносто девять"
Halalas = "& 99/100 риалов"


Case Else
Halalas = "&" & Halalas & "Halalas"
End Select
SpellBilling = риалы и халалы
End Function


' Преобразует число от 100 до 999 в текст
Функция GetHundreds(ByVal MyNumber)
Затемнить результат как строку
Если Val(MyNumber) = 0, то выход из функции
МойЧисло = Правильно ("000" & МойЧисло, 3)
' Преобразование разряда сотен.
Если Середина(МойЧисло, 1, 1) <> "0" Тогда
Результат = GetDigit(Mid(MyNumber, 1, 1)) & "Сотня"
End If
' Преобразование разряда десятков и единиц.
Если Середина(МойЧисло, 2, 1) <> "0" Тогда
Результат = Результат и GetTens (Mid (MyNumber, 2))
Еще
Результат = Результат и GetDigit (Mid (MyNumber, 3))
End If
ПолучитьСотни = Результат
End Function

' Преобразует число от 10 до 99 в текст.
Функция GetTens(TensText)
Затемнить результат как строку
Result = "" ' Обнуление временного значения функции.
If Val(Left(TensText, 1)) = 1 Then ' Если значение между 10-19...
Выберите Case Val (TensText)
Случай 10: Результат = "Десять"
Случай 11: Результат = "Одиннадцать"
Случай 12: Результат = "Двенадцать"
Случай 13: Результат = "Тринадцать"
Случай 14: Результат = "Четырнадцать"
Случай 15: Результат = "Пятнадцать"
Случай 16: Результат = "Шестнадцать"
Случай 17: Результат = "Семнадцать"
Случай 18: Результат = "Восемнадцать"
Случай 19: Результат = "Девятнадцать"
Case Else
End Select
Else ' Если значение от 20 до 99...
Выберите Case Val(Left(TensText, 1))
Случай 2: Результат = "Двадцать"
Случай 3: Результат = "Тридцать"
Случай 4: Результат = "сорок"
Случай 5: Результат = "Пятьдесят"
Случай 6: Результат = "Шестьдесят"
Случай 7: Результат = "Семьдесят"
Случай 8: Результат = "Восемьдесят"
Случай 9: Результат = "Девяносто"
Case Else
End Select
Результат = Результат и GetDigit _
(Right(TensText, 1)) ' Получить разряд единиц.
End If
ПолучитьДесятки = Результат
End Function

' Преобразует число от 1 до 9 в текст.
Функция GetDigit(Цифра)
Выберите регистр Val (цифра)
Случай 1: GetDigit = "Один"
Случай 2: GetDigit = "Два"
Случай 3: GetDigit = "Три"
Случай 4: GetDigit = "Четыре"
Случай 5: GetDigit = "Пять"
Случай 6: GetDigit = "Шесть"
Случай 7: GetDigit = "Семь"
Случай 8: GetDigit = "Восемь"
Случай 9: GetDigit = "Девять"
Другое дело: GetDigit = ""
End Select
End Function
Этот комментарий был сведен к минимуму модератором на сайте
Нечего сказать! Экстремальносупер
Этот комментарий был сведен к минимуму модератором на сайте
Уважаемые господа,

Добрый день,
Я протестировал ваш код VBA, но, к сожалению, он плохо работает с отрицательными/минусовыми значениями, такими как -100 -10,000 100/(10,000) (XNUMX XNUMX).

Сэр, я использую приведенный ниже код в течение последних 1 года, и сегодня я обнаружил ту же ошибку, что и в вашем коде VBA.

Когда я пишу минус -10,000 XNUMX, это показывает "Всего сто десять тысяч".
Когда я пишу положительные 10,000 XNUMX, он показывает, что «Только десять тысяч» работает нормально.

Пример ниже:

(10,000.99 99) Всего сто десять тысяч и 100/XNUMX риалов
10,000.99 99 всего десять тысяч и 100/XNUMX риалов
(10,000,000.99 99 100) Всего сто десять миллионов и XNUMX/XNUMX риалов
10,000,000.99 99 100 всего десять миллионов и XNUMX/XNUMX риалов
(10,000,000,000.99 99 100 XNUMX) Всего сто десять миллиардов и XNUMX/XNUMX риалов
10,000,000,000.99 99 100 XNUMX всего десять миллиардов и XNUMX/XNUMX риалов
(10,000,000,000,000.90 90 100 XNUMX XNUMX) Всего сто десять триллионов и XNUMX/XNUMX риалов
10,000,000,000,000.90 90 100 XNUMX XNUMX Всего десять триллионов и XNUMX/XNUMX риалов

Формула = правописание

МОЙ КОД VBA:

'Основная функция
Функция SpellBilling(ByVal MyNumber)
Дим Риал, Халала, Темп
Dim DecimalPlace, граф
ReDim Place(9) как строка
Место(2) = "Тысяча"
Место (3) = "Миллион"
Место (4) = "Миллиард"
Место (5) = "Триллион"
' Строковое представление суммы.
МойЧисло = Обрезать(Стр(МойЧисло))
' Позиция десятичного знака 0, если нет.
DecimalPlace = InStr(MyNumber, ".")
' Преобразуйте Halalas и установите MyNumber на сумму в риалах.
Если Десятичный Разряд > 0 Тогда
Halalas = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim (Left (MyNumber, DecimalPlace - 1))
End If
Count = 1
Делать пока MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
Если Temp <> "" Тогда риалы = Temp & Place(Count) & Riyals
Если Лен(МойЧисло) > 3 Тогда
МойЧисло = Слева(МойЧисло, Лен(МойЧисло) - 3)
Еще
МойНомер = ""
End If
Count = Count + 1
Петля
Выберите кейс риалы
Случай ""
Риалы = "Нет риалов"
Дело «Один»
Риалы = "Только один риал"
Case Else
Риалы = «Только» и риалы
Риалы = риалы и ""
End Select
Выберите кейс Халалас
Случай ""
Halalas = "& 00/00 риалов"
Дело «Один»
Halalas = "& 01/100 риалов"
Дело «Двое»
Halalas = "& 02/100 риалов"
Дело «Три»
Halalas = "& 03/100 риалов"
Дело «Четыре»
Halalas = "& 04/100 риалов"
Дело «Пять»
Halalas = "& 05/100 риалов"
Корпус "Шесть"
Halalas = "& 06/100 риалов"
Дело "Семь"
Halalas = "& 07/100 риалов"
Дело «Восемь»
Halalas = "& 08/100 риалов"
Дело «Девять»
Halalas = "& 09/100 риалов"
Дело «Десятка»
Halalas = "& 10/100 риалов"
Дело «Одиннадцать»
Halalas = "& 11/100 риалов"
Дело «Двенадцать»
Halalas = "& 12/100 риалов"
Дело «Тринадцать»
Halalas = "& 13/100 риалов"
Дело «Четырнадцать»
Halalas = "& 14/100 риалов"
Дело «Пятнадцать»
Halalas = "& 15/100 риалов"
Дело «Шестнадцать»
Halalas = "& 16/100 риалов"
Дело «Семнадцать»
Halalas = "& 17/100 риалов"
Дело «Восемнадцать»
Halalas = "& 18/100 риалов"
Дело «Девятнадцать»
Halalas = "& 19/100 риалов"
Дело «Двадцать»
Halalas = "& 20/100 риалов"
Кейс «Двадцать одно»
Halalas = "& 21/100 риалов"
Кейс «Двадцать два»
Halalas = "& 22/100 риалов"
Кейс «Двадцать три»
Halalas = "& 23/100 риалов"
Кейс «Двадцать четыре»
Halalas = "& 24/100 риалов"
Кейс «Двадцать пять»
Halalas = "& 25/100 риалов"
Кейс «Двадцать шесть»
Halalas = "& 26/100 риалов"
Кейс "Двадцать семь"
Halalas = "& 27/100 риалов"
Дело «Двадцать восемь»
Halalas = "& 28/100 риалов"
Кейс "Двадцать девять"
Halalas = "& 29/100 риалов"
Дело «Тридцать».
Halalas = "& 30/100 риалов"
Дело «Тридцать первое»
Halalas = "& 31/100 риалов"
Дело «Тридцать два»
Halalas = "& 32/100 риалов"
Дело «Тридцать три»
Halalas = "& 33/100 риалов"
Кейс «Тридцать четыре»
Halalas = "& 34/100 риалов"
Дело «Тридцать пять»
Halalas = "& 35/100 риалов"
Кейс «Тридцать шесть»
Halalas = "& 36/100 риалов"
Дело «Тридцать семь»
Halalas = "& 37/100 риалов"
Дело «Тридцать восемь»
Halalas = "& 38/100 риалов"
Кейс «Тридцать девять»
Halalas = "& 39/100 риалов"
Корпус "Сорок"
Halalas = "& 40/100 риалов"
Кейс «Сорок один»
Halalas = "& 41/100 риалов"
Кейс «Сорок два»
Halalas = "& 42/100 риалов"
Дело «Сорок три»
Halalas = "& 43/100 риалов"
Кейс «Сорок четыре»
Halalas = "& 44/100 риалов"
Кейс «Сорок пять»
Halalas = "& 45/100 риалов"
Кейс «Сорок шесть»
Halalas = "& 46/100 риалов"
Кейс «Сорок семь»
Halalas = "& 47/100 риалов"
Дело "Сорок восемь"
Halalas = "& 48/100 риалов"
Кейс "Сорок девять"
Halalas = "& 49/100 риалов"
Кейс "Пятьдесят"
Halalas = "& 50/100 риалов"
Кейс «Пятьдесят один»
Halalas = "& 51/100 риалов"
Дело «Пятьдесят два»
Halalas = "& 52/100 риалов"
Дело «Пятьдесят три»
Halalas = "& 53/100 риалов"
Кейс «Пятьдесят четыре»
Halalas = "& 54/100 риалов"
Кейс "Пятьдесят пять"
Halalas = "& 55/100 риалов"
Кейс «Пятьдесят шесть»
Halalas = "& 56/100 риалов"
Кейс "Пятьдесят семь"
Halalas = "& 57/100 риалов"
Дело "Пятьдесят восемь"
Halalas = "& 58/100 риалов"
Кейс "Пятьдесят девять"
Halalas = "& 59/100 риалов"
Кейс "Шестьдесят"
Halalas = "& 60/100 риалов"
Кейс «Шестьдесят один»
Halalas = "& 61/100 риалов"
Кейс «Шестьдесят два»
Halalas = "& 62/100 риалов"
Кейс «Шестьдесят три»
Halalas = "& 63/100 риалов"
Кейс «Шестьдесят четыре»
Halalas = "& 64/100 риалов"
Кейс «Шестьдесят пять»
Halalas = "& 65/100 риалов"
Кейс «Шестьдесят шесть»
Halalas = "& 66/100 риалов"
Кейс «Шестьдесят семь»
Halalas = "& 67/100 риалов"
Кейс «Шестьдесят восемь»
Halalas = "& 68/100 риалов"
Кейс "Шестьдесят девять"
Halalas = "& 69/100 риалов"
Кейс "Семьдесят"
Halalas = "& 70/100 риалов"
Кейс «Семьдесят один»
Halalas = "& 71/100 риалов"
Дело «Семьдесят два»
Halalas = "& 72/100 риалов"
Кейс «Семьдесят три»
Halalas = "& 73/100 риалов"
Кейс «Семьдесят четыре»
Halalas = "& 74/100 риалов"
Кейс "Семьдесят пять"
Halalas = "& 75/100 риалов"
Кейс «Семьдесят шесть»
Halalas = "& 76/100 риалов"
Кейс "Семьдесят семь"
Halalas = "& 77/100 риалов"
Дело «Семьдесят восемь»
Halalas = "& 78/100 риалов"
Кейс "Семьдесят девять"
Halalas = "& 79/100 риалов"
Дело "Восемьдесят"
Halalas = "& 80/100 риалов"
Кейс «Восемьдесят один»
Halalas = "& 81/100 риалов"
Кейс «Восемьдесят два»
Halalas = "& 82/100 риалов"
Кейс «Восемьдесят три»
Halalas = "& 83/100 риалов"
Кейс «Восемьдесят четыре»
Halalas = "& 84/100 риалов"
Кейс «Восемьдесят пять»
Halalas = "& 85/100 риалов"
Кейс «Восемьдесят шесть»
Halalas = "& 86/100 риалов"
Кейс «Восемьдесят семь»
Halalas = "& 87/100 риалов"
Дело "Восемьдесят восемь"
Halalas = "& 88/100 риалов"
Кейс "Восемьдесят девять"
Halalas = "& 89/100 риалов"
Дело "Девяносто"
Halalas = "& 90/100 риалов"
Кейс «Девяносто один»
Halalas = "& 91/100 риалов"
Дело «Девяносто два»
Halalas = "& 92/100 риалов"
Дело «Девяносто три»
Halalas = "& 93/100 риалов"
Кейс «Девяносто четыре»
Halalas = "& 94/100 риалов"
Дело "Девяносто пять"
Halalas = "& 95/100 риалов"
Кейс «Девяносто шесть»
Halalas = "& 96/100 риалов"
Кейс «Девяносто семь»
Halalas = "& 97/100 риалов"
Дело «Девяносто восемь»
Halalas = "& 98/100 риалов"
Кейс "Девяносто девять"
Halalas = "& 99/100 риалов"


Case Else
Halalas = "&" & Halalas & "Halalas"
End Select
SpellBilling = риалы и халалы
End Function


' Преобразует число от 100 до 999 в текст
Функция GetHundreds(ByVal MyNumber)
Затемнить результат как строку
Если Val(MyNumber) = 0, то выход из функции
МойЧисло = Правильно ("000" & МойЧисло, 3)
' Преобразование разряда сотен.
Если Середина(МойЧисло, 1, 1) <> "0" Тогда
Результат = GetDigit(Mid(MyNumber, 1, 1)) & "Сотня"
End If
' Преобразование разряда десятков и единиц.
Если Середина(МойЧисло, 2, 1) <> "0" Тогда
Результат = Результат и GetTens (Mid (MyNumber, 2))
Еще
Результат = Результат и GetDigit (Mid (MyNumber, 3))
End If
ПолучитьСотни = Результат
End Function

' Преобразует число от 10 до 99 в текст.
Функция GetTens(TensText)
Затемнить результат как строку
Result = "" ' Обнуление временного значения функции.
If Val(Left(TensText, 1)) = 1 Then ' Если значение между 10-19...
Выберите Case Val (TensText)
Случай 10: Результат = "Десять"
Случай 11: Результат = "Одиннадцать"
Случай 12: Результат = "Двенадцать"
Случай 13: Результат = "Тринадцать"
Случай 14: Результат = "Четырнадцать"
Случай 15: Результат = "Пятнадцать"
Случай 16: Результат = "Шестнадцать"
Случай 17: Результат = "Семнадцать"
Случай 18: Результат = "Восемнадцать"
Случай 19: Результат = "Девятнадцать"
Case Else
End Select
Else ' Если значение от 20 до 99...
Выберите Case Val(Left(TensText, 1))
Случай 2: Результат = "Двадцать"
Случай 3: Результат = "Тридцать"
Случай 4: Результат = "сорок"
Случай 5: Результат = "Пятьдесят"
Случай 6: Результат = "Шестьдесят"
Случай 7: Результат = "Семьдесят"
Случай 8: Результат = "Восемьдесят"
Случай 9: Результат = "Девяносто"
Case Else
End Select
Результат = Результат и GetDigit _
(Right(TensText, 1)) ' Получить разряд единиц.
End If
ПолучитьДесятки = Результат
End Function

' Преобразует число от 1 до 9 в текст.
Функция GetDigit(Цифра)
Выберите регистр Val (цифра)
Случай 1: GetDigit = "Один"
Случай 2: GetDigit = "Два"
Случай 3: GetDigit = "Три"
Случай 4: GetDigit = "Четыре"
Случай 5: GetDigit = "Пять"
Случай 6: GetDigit = "Шесть"
Случай 7: GetDigit = "Семь"
Случай 8: GetDigit = "Восемь"
Случай 9: GetDigit = "Девять"
Другое дело: GetDigit = ""
End Select
End Function
Этот комментарий был сведен к минимуму модератором на сайте
Мне нужно применить всю книгу Excell. Как применить это кодирование ко всем книгам Excel.
Этот комментарий был сведен к минимуму модератором на сайте
Rupees Fourteen Thousand Eight Hundred , Seventy Five Только последняя сумма должна содержать слово andexample
Всего четырнадцать тысяч восемьсот семьдесят пять рупий.
Этот комментарий был сведен к минимуму модератором на сайте
не может прочитать больше 10 крор.
Этот комментарий был сведен к минимуму модератором на сайте
Один лак шестьдесят девять тысяч восемьдесят один и сорок два пайса - неправильно преобразовано. Также не преобразовано приведенное выше число при округлении.
Этот комментарий был сведен к минимуму модератором на сайте
СПАСИБО ЗА КОД...
Этот комментарий был сведен к минимуму модератором на сайте
Спасибо за кодировку. Я подал заявку, и она работает. Но это применимо только к этой конкретной книге. Мне нужно применить всю книгу Excell. Как применить это кодирование ко всем книгам Excel.
Этот комментарий был сведен к минимуму модератором на сайте
Привет, СиваГ
Да, этот код является пользовательской функцией, вы должны применить формулу к файлам один за другим, если вам нужен код для применения к нескольким книгам, он будет применяться ко всем числам, поэтому все числа будут изменены. И код не может поддерживать отмену, есть некоторые риски безопасности. Делать это не рекомендуется. Благодарю вас!
Этот комментарий был сведен к минимуму модератором на сайте
Как убрать слово "рупии"? Обычно на чековых листах уже есть слово «рупии».
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуй, Сакария.
Чтобы решить вашу проблему, примените следующий код:
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 = 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



Пожалуйста, попробуйте, надеюсь, это поможет вам!
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо... 🙂
Этот комментарий был сведен к минимуму модератором на сайте
Но это применимо только к одному excel. Если я ввожу эту формулу в другой Excel, это не работает
какое решение для этого
пожалуйста, верните
Этот комментарий был сведен к минимуму модератором на сайте
Здравствуйте,

Если у вас несколько книг, вам нужно скопировать код в несколько книг.
Если вы скопируете его только в одну книгу, он не будет работать в других книгах. 😀
Пожалуйста, попробуйте, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Большое спасибо это очень полезно
Этот комментарий был сведен к минимуму модератором на сайте
Привет, сэр. Можно ли установить это по умолчанию для каждого рабочего листа Excel или нет?
Этот комментарий был сведен к минимуму модератором на сайте
Привет, Мукеш

Да, пока код копируется в оконный модуль vba, формулу можно применить ко всей книге.
Но при закрытии книги вы должны сохранить ее как Excel Macro-Enabled Workbook формат файла.
Пожалуйста, попробуйте, спасибо!
Этот комментарий был сведен к минимуму модератором на сайте
Пробовал несколько раз не работает. Пожалуйста помоги
Этот комментарий был сведен к минимуму модератором на сайте
Эй, отличная помощь! Спасибо за создание такого замечательного кода.

Это сэкономило много времени. "Будьте здоровы!!"
Здесь еще нет комментариев
Оставляйте свои комментарии
Публикация как гость
×
Оценить этот пост:
0   Характеристики
Предлагаемые места

Подписывайтесь на Нас

Copyright © 2009 - www.extendoffice.ком. | Все права защищены. Питаться от ExtendOffice, | Карта сайта
Microsoft и логотип Office являются товарными знаками или зарегистрированными товарными знаками Microsoft Corporation в США и / или других странах.
Защищено Sectigo SSL