Μετάβαση στο κύριο περιεχόμενο

Πώς να μετατρέψετε τους αριθμούς σε λέξεις σε ινδικές ρουπίες στο 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. Αφού εισαγάγετε τον κωδικό, αποθηκεύστε και κλείστε το παράθυρο κώδικα, επιστρέψτε στο φύλλο εργασίας και εισαγάγετε αυτόν τον τύπο: = RupeeFormat (A2) σε ένα κενό κελί και, στη συνέχεια, σύρετε τη λαβή πλήρωσης προς τα κάτω για να εφαρμόσετε αυτόν τον τύπο σε άλλα κελιά, όλοι οι αριθμοί έχουν διατυπωθεί σε ρουπίες, δείτε το στιγμιότυπο οθόνης:


Μετατρέψτε τους αριθμούς σε λέξεις σε αγγλικό δολάριο με μια καταπληκτική δυνατότητα

Εάν θέλετε να μετατρέψετε τους αριθμούς σε λέξεις σε αγγλικό δολάριο, Kutools για Excel'S Αριθμοί σε λέξεις Η δυνατότητα μπορεί να σας βοηθήσει να επιλύσετε αυτήν την εργασία γρήγορα και εύκολα.

Συμβουλές:Για να το εφαρμόσετε Αριθμός σε λέξεις χαρακτηριστικό, πρώτα, πρέπει να κατεβάσετε το Kutools για Excelκαι, στη συνέχεια, εφαρμόστε τη λειτουργία γρήγορα και εύκολα.

Μετά την εγκατάσταση Kutools για Excel, κάντε το ως εξής:

1. Επιλέξτε τη λίστα των αριθμών που θέλετε να μετατρέψετε και, στη συνέχεια, κάντε κλικ στο Kutools > Περιεχόμενο > Αριθμοί σε λέξεις, δείτε στιγμιότυπα οθόνης:

2. Στην Αριθμοί σε λέξεις νομίσματος , επιλέξτε Αγγλικά Επιλογή από το Γλώσσες ενότητα και, στη συνέχεια, κάντε κλικ στο Ok κουμπί, οι αριθμοί στην επιλογή έχουν μετατραπεί σε λέξεις αγγλικού νομίσματος, δείτε το στιγμιότυπο οθόνης:

Κάντε κλικ για λήψη του Kutools για Excel και δωρεάν δοκιμή τώρα!

 


  • Super Formula Bar (επεξεργαστείτε εύκολα πολλές γραμμές κειμένου και τύπου). Διάταξη ανάγνωσης (εύκολη ανάγνωση και επεξεργασία μεγάλου αριθμού κελιών). Επικόλληση σε φιλτραρισμένο εύρος...
  • Συγχώνευση κελιών / σειρών / στηλών και τήρηση δεδομένων · Περιεχόμενο διαχωρισμού κελιών Συνδυάστε διπλές σειρές και άθροισμα / μέσος όρος... Αποτροπή διπλών κυττάρων; Συγκρίνετε τα εύρη...
  • Επιλέξτε Διπλότυπο ή Μοναδικό Σειρές; Επιλέξτε Κενές σειρές (όλα τα κελιά είναι κενά). Σούπερ εύρεση και ασαφής εύρεση σε πολλά βιβλία εργασίας. Τυχαία επιλογή ...
  • Ακριβές αντίγραφο Πολλαπλά κελιά χωρίς αλλαγή της αναφοράς τύπου. Αυτόματη δημιουργία αναφορών σε πολλαπλά φύλλα? Εισαγωγή κουκκίδων, Πλαίσια ελέγχου και άλλα ...
  • Αγαπημένα και γρήγορη εισαγωγή τύπων, Σειρά, Διαγράμματα και Εικόνες; Κρυπτογράφηση κυττάρων με κωδικό πρόσβασης Δημιουργία λίστας αλληλογραφίας και στείλτε email ...
  • Εξαγωγή κειμένου, Προσθήκη κειμένου, Κατάργηση κατά θέση, Αφαιρέστε το διάστημα; Δημιουργία και εκτύπωση υποσύνολων σελιδοποίησης. Μετατροπή περιεχομένου και σχολίων μεταξύ κελιών...
  • Σούπερ φίλτρο (αποθηκεύστε και εφαρμόστε σχήματα φίλτρων σε άλλα φύλλα). Προηγμένη ταξινόμηση ανά μήνα / εβδομάδα / ημέρα, συχνότητα και άλλα. Ειδικό φίλτρο με έντονη, πλάγια ...
  • Συνδυάστε βιβλία εργασίας και φύλλα εργασίας; Συγχώνευση πινάκων βάσει βασικών στηλών. Διαχωρίστε τα δεδομένα σε πολλά φύλλα; Μαζική μετατροπή xls, xlsx και PDF...
  • Ομαδοποίηση συγκεντρωτικού πίνακα κατά αριθμός εβδομάδας, ημέρα εβδομάδας και πολλά άλλα ... Εμφάνιση ξεκλειδωμένων, κλειδωμένων κελιών με διαφορετικά χρώματα. Επισημάνετε τα κελιά που έχουν τύπο / όνομα...
kte καρτέλα 201905
  • Ενεργοποίηση επεξεργασίας και ανάγνωσης καρτελών σε Word, Excel, PowerPoint, Publisher, Access, Visio και Project.
  • Ανοίξτε και δημιουργήστε πολλά έγγραφα σε νέες καρτέλες του ίδιου παραθύρου και όχι σε νέα παράθυρα.
  • Αυξάνει την παραγωγικότητά σας κατά 50% και μειώνει εκατοντάδες κλικ του ποντικιού για εσάς κάθε μέρα!
κάτω μέρος γραφείου

 

Comments (28)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hi
How to eliminate paisa from the code
This comment was minimized by the moderator on the site
thanks alot
This comment was minimized by the moderator on the site
Hi,

Whenever I am saving this file, its showing below message.

Be Careful! Parts of your document may include personal information that can't be removed by the Document Inspector.

Pls suggest if this is safe and if yes, how can we remove this message window permanently.
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
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