انتقل إلى المحتوى الرئيسي

كيفية تحويل الأرقام إلى كلمات بالروبية الهندية في إكسيل؟

في هذه المقالة ، سأقدم لك كيفية تحويل قائمة الأرقام إلى كلمات بالروبية الهندية أو الدولار الإنجليزي في Excel.

تحويل الأرقام إلى كلمات بالروبية الهندية باستخدام كود VBA

تحويل الأرقام إلى كلمات بالدولار الإنجليزي مع ميزة مذهلة


تحويل الأرقام إلى كلمات بالروبية الهندية باستخدام كود VBA

يمكن أن يساعدك رمز فبا التالي في تحويل الأرقام إلى كلمات بالروبية ، يرجى القيام بذلك على النحو التالي:

1. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة، والصق التعليمة البرمجية التالية في نافذة الوحدة النمطية.

كود فبا: تحويل الأرقام إلى كلمات بالروبية

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) في خلية فارغة ، ثم اسحب مقبض التعبئة لأسفل لتطبيق هذه الصيغة على الخلايا الأخرى ، تم توضيح جميع الأرقام بالروبية ، انظر الصورة:


تحويل الأرقام إلى كلمات بالدولار الإنجليزي مع ميزة مذهلة

إذا كنت تريد تحويل الأرقام إلى كلمات بالدولار الإنجليزي ، Kutools for Excelالصورة أرقام إلى كلمات يمكن أن تساعدك الميزة في حل هذه الوظيفة بسرعة وسهولة.

نصيحة:لتطبيق هذا عدد الكلمات الميزة ، أولاً ، يجب عليك تنزيل ملف Kutools for Excel، ثم قم بتطبيق الميزة بسرعة وسهولة.

بعد تثبيت Kutools for Excel، يرجى القيام بذلك على النحو التالي:

1. حدد قائمة الأرقام التي تريد تحويلها ، ثم انقر فوق كوتولس > وصف المنتج > أرقام إلى كلمات، انظر لقطات الشاشة:

2. في الأرقام إلى كلمات العملات مربع الحوار، حدد عربي الخيار من اللغات ، ثم انقر فوق Ok زر ، تم تحويل الأرقام الموجودة في التحديد إلى كلمات العملة الإنجليزية ، انظر الصورة:

انقر للتنزيل Kutools for Excel وتجربة مجانية الآن!

 


  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة وحفظ البيانات. تقسيم محتوى الخلايا ؛ اجمع الصفوف المكررة والمجموع / المتوسط... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • المفضلة وإدراج الصيغ بسرعةوالنطاقات والمخططات والصور ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • تجميع الجدول المحوري حسب رقم الأسبوع واليوم من الأسبوع والمزيد ... إظهار الخلايا غير المؤمنة والمغلقة بألوان مختلفة قم بتمييز الخلايا التي لها صيغة / اسم
علامة تبويب kte 201905
  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع

 

Comments (25)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Your code is probably the best one I have found so far on the internet. It is really nice and useful. I request to include a small facility if possible. Can you please modify the code, so that "and" will be displayed before the last denomination. For example, the amount 22,44,556 will be converted to "Rupees Twenty Two Lacs Forty Four Thousand Five Hundred Fifty Six Only". It will be best, if it can be converted as "Rupees Twenty Two Lacs Forty Four Thousand Five Hundred and Fifty Six Only". Kindly consider my request.
This comment was minimized by the moderator on the site
The VBA code works effectively. Thanks for sharing these simple and easy to follow tips & steps.
This comment was minimized by the moderator on the site
Can u pls share the code that would spell number for 9000 crore
This comment was minimized by the moderator on the site
Hey, Great Help! Thanks for creating such a wonderful code.

It has saved a lot of time. "God Bless You!!"
This comment was minimized by the moderator on the site
Tried multiple times it's not working. Please help
This comment was minimized by the moderator on the site
Hi Sir, Is it possible to set this for by default for every excel working sheet or not ?
This comment was minimized by the moderator on the site
Hello, Mukesh

Yes, as long as the code is copied into the vba window module, the formula can be applied to the whole workbook.
But when closing the workbook, you should save it as Excel Macro-Enabled Workbook file format.
Please have a try, thank you!
This comment was minimized by the moderator on the site
Thanks a lot it is very Helpful
This comment was minimized by the moderator on the site
But this applicable to only one excel. If I enter this formula in other excel this is not working
what is solution for this
please revert
This comment was minimized by the moderator on the site
Hello,

If you have several workbooks, you need to copy the code to several workbooks.
If you only copy it to one workbook, it will not work in other workbooks. 😀
Please try, thank you!
This comment was minimized by the moderator on the site
How can remove the word "Rupees"? Normally cheque leaves have the word "Rupees" already.
This comment was minimized by the moderator on the site
Hello, Sakariya
To solve your problem, please apply the below code:
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



Please try, hope it can help you!
This comment was minimized by the moderator on the site
Thanks a lot... 🙂
This comment was minimized by the moderator on the site
Thanku for the coding. I applied & its Working. But its only apply for that particular workbook only. I Need to apply all Excell Workbook. How to apply this coding to all excel workbook.
This comment was minimized by the moderator on the site
Hello,SivaG
Yes, this code is User Defined Function, you should apply the formula to the files one by one, if you need a code to apply to multiple workbooks, it will applied to all numbers, so all the numbers will be changed. And the code can't support undo, there are some security risks. It is not recommended to do this. Thank you!
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations