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

كيفية تحويل العملات إلى نص كلمات في إكسيل؟

بالنسبة لغير الناطقين بها الذين يستخدمون اللغة الإنجليزية كلغة ثانية ، يصعب أحيانًا تغيير رقم العملة مباشرة إلى الكلمات الإنجليزية عندما يكون الرقم طويلًا جدًا. في هذه المقالة ، ستتعلم كيفية تحويل العملات بسهولة إلى نص كلمات في Excel.

تحويل العملة إلى كلمات برمز VBA
تحويل العملات إلى كلمات مع كوتولس ل إكسيل


تحويل العملة إلى كلمات برمز VBA

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

1. صحافة قديم + F11 لفتح ميكروسوفت فيسوال باسيك للتطبيقات صندوق المحادثة.

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

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

Function NumberstoWords(ByVal pNumber)
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
    xHundred = ""
    xValue = Right(pNumber, 3)
    If Val(xValue) <> 0 Then
        xValue = Right("000" & xValue, 3)
        If Mid(xValue, 1, 1) <> "0" Then
            xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
        End If
        If Mid(xValue, 2, 1) <> "0" Then
            xHundred = xHundred & GetTens(Mid(xValue, 2))
        Else
            xHundred = xHundred & GetDigit(Mid(xValue, 3))
        End If
    End If
    If xHundred <> "" Then
        Dollars = xHundred & arr(xIndex) & Dollars
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop
Select Case Dollars
    Case ""
        Dollars = "No Dollars"
    Case "One"
        Dollars = "One Dollar"
    Case Else
        Dollars = Dollars & " Dollars"
End Select
Select Case Cents
    Case ""
        Cents = " and No Cents"
    Case "One"
        Cents = " and One Cent"
    Case Else
        Cents = " and " & Cents & " Cents"
End Select
NumberstoWords = Dollars & Cents
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
    Select Case Val(pTens)
        Case 10: Result = "Ten"
        Case 11: Result = "Eleven"
        Case 12: Result = "Twelve"
        Case 13: Result = "Thirteen"
        Case 14: Result = "Fourteen"
        Case 15: Result = "Fifteen"
        Case 16: Result = "Sixteen"
        Case 17: Result = "Seventeen"
        Case 18: Result = "Eighteen"
        Case 19: Result = "Nineteen"
        Case Else
    End Select
Else
Select Case Val(Left(pTens, 1))
    Case 2: Result = "Twenty "
    Case 3: Result = "Thirty "
    Case 4: Result = "Forty "
    Case 5: Result = "Fifty "
    Case 6: Result = "Sixty "
    Case 7: Result = "Seventy "
    Case 8: Result = "Eighty "
    Case 9: Result = "Ninety "
    Case Else
End Select
Result = Result & GetDigit(Right(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
    Case 1: GetDigit = "One"
    Case 2: GetDigit = "Two"
    Case 3: GetDigit = "Three"
    Case 4: GetDigit = "Four"
    Case 5: GetDigit = "Five"
    Case 6: GetDigit = "Six"
    Case 7: GetDigit = "Seven"
    Case 8: GetDigit = "Eight"
    Case 9: GetDigit = "Nine"
    Case Else: GetDigit = ""
End Select
End Function

3. صحافة قديم + Q مفاتيح في نفس الوقت لإغلاق ميكروسوفت فيسوال باسيك للتطبيقات صندوق المحادثة.

4. حدد خلية فارغة (B1) مجاورة للخلية التي تريد تحويلها إلى كلمات ، أدخل الصيغة = NumberstoWords (A1)، ثم اضغط على أدخل الرئيسية.

ملاحظة: A1 هي الخلية التي تحتوي على رقم العملة. يمكنك تغييره كما تريد.

5. حدد الخلية B1 ، واسحب مقبض التعبئة لأسفل للحصول على جميع الكلمات الإنجليزية لأرقام العملات.


تحويل العملات إلى كلمات مع كوتولس ل إكسيل

يبدو رمز VBA الطويل هذا معقدًا. هنا سأقدم لك أداة مفيدة لحل هذه المشكلة بسهولة. مع ال أرقام إلى كلمات فائدة كوتولس ل إكسيل، لن يكون تحويل العملات إلى كلمات مشكلة بعد الآن. الرجاء القيام بما يلي.

قبل التطبيق كوتولس ل إكسيلالرجاء قم بتنزيله وتثبيته أولاً.

1. حدد الخلايا التي تحتوي على أرقام العملات التي تريد تحويلها.

2. انقر كوتولس > وصف المنتج > أرقام إلى كلمات. انظر لقطة الشاشة:

3. في ال الأرقام إلى كلمات العملات مربع الحوار، حدد الانجليزية الخيار، وانقر فوق OK or قم بالمشاركة .

الآن يتم تحويل أرقام العملات المحددة إلى كلمات إنجليزية على الفور.

  إذا كنت ترغب في الحصول على نسخة تجريبية مجانية (30-يوم) من هذه الأداة ، الرجاء الضغط لتنزيلهثم انتقل لتطبيق العملية حسب الخطوات المذكورة أعلاه.


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع
فرز التعليقات حسب
التعليقات (16)
لا يوجد تقييم. كن أول من يقيم!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
العملة دائمًا بالدولار والسنت ، كيف يمكننا تغييرها إلى عملة أخرى؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
يمكنك تغيير الرمز إلى عملتك بدلاً من "دمى"
تم تصغير هذا التعليق بواسطة المشرف على الموقع
السيد شاجي هل يمكنك إرشادك بالخطوات من فضلك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
راجع مقال إرشادات للمبتدئين في تحويل المليون مليار تريليون للتعرف على نظام الأرقام وتحويل الأرقام وفهمه.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لا يمكن تغيير العملة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
أنا أحب الماكرو الخاص بك. وجدت شيئًا واحدًا لا يعمل بشكل جيد. هذا عندما يكون هناك كسور. على سبيل المثال ، إذا ظهر الحقل كـ .835 excel ، فإنه يتم تقريبه إلى أعلى ولكن يتم كتابة القيمة على أنها "ثلاثة وثمانين سنتًا" بينما يظهر Excel 84.
العمل حول هذا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،
نأسف للإزعاج. لقد قمنا بتحديث الكود ، يرجى المحاولة.

Function NumberstoWords(ByVal pNumber)
'Updated by Extendoffice 20220428
Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
pNumber = Round(pNumber, 2)
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
    xHundred = ""
    xValue = Right(pNumber, 3)
    If Val(xValue) <> 0 Then
        xValue = Right("000" & xValue, 3)
        If Mid(xValue, 1, 1) <> "0" Then
            xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
        End If
        If Mid(xValue, 2, 1) <> "0" Then
            xHundred = xHundred & GetTens(Mid(xValue, 2))
        Else
            xHundred = xHundred & GetDigit(Mid(xValue, 3))
        End If
    End If
    If xHundred <> "" Then
        Dollars = xHundred & arr(xIndex) & Dollars
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop
Select Case Dollars
    Case ""
        Dollars = "No Dollars"
    Case "One"
        Dollars = "One Dollar"
    Case Else
        Dollars = Dollars & " Dollars"
End Select
Select Case Cents
    Case ""
        Cents = " and No Cents"
    Case "One"
        Cents = " and One Cent"
    Case Else
        Cents = " and " & Cents & " Cents"
End Select
NumberstoWords = Dollars & Cents
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
    Select Case Val(pTens)
        Case 10: Result = "Ten"
        Case 11: Result = "Eleven"
        Case 12: Result = "Twelve"
        Case 13: Result = "Thirteen"
        Case 14: Result = "Fourteen"
        Case 15: Result = "Fifteen"
        Case 16: Result = "Sixteen"
        Case 17: Result = "Seventeen"
        Case 18: Result = "Eighteen"
        Case 19: Result = "Nineteen"
        Case Else
    End Select
Else
Select Case Val(Left(pTens, 1))
    Case 2: Result = "Twenty "
    Case 3: Result = "Thirty "
    Case 4: Result = "Forty "
    Case 5: Result = "Fifty "
    Case 6: Result = "Sixty "
    Case 7: Result = "Seventy "
    Case 8: Result = "Eighty "
    Case 9: Result = "Ninety "
    Case Else
End Select
Result = Result & GetDigit(Right(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
    Case 1: GetDigit = "One"
    Case 2: GetDigit = "Two"
    Case 3: GetDigit = "Three"
    Case 4: GetDigit = "Four"
    Case 5: GetDigit = "Five"
    Case 6: GetDigit = "Six"
    Case 7: GetDigit = "Seven"
    Case 8: GetDigit = "Eight"
    Case 9: GetDigit = "Nine"
    Case Else: GetDigit = ""
End Select
End Function
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ساعدني هذا الماكرو هنا كثيرًا ، شكرًا جزيلاً لك على ذلك. عملتنا هنا في الكويت مكونة من ثلاثة أرقام بعد العلامة العشرية ، هل يمكنك مساعدتي في ذلك؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
إذا كان 45.67 مكتوبًا على أنه خمسة وأربعون دولارًا ، وسبعة وستون سنتًا ، فكيف يتم كتابة 45.678؟ هل هو خمسة وأربعون دولارًا وستمائة وثمانية وسبعون سنتًا؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل تريد حلاً لا يتطلب VBA؟
التحقق من ذلك هنا
انظر النتيجة في لقطة الشاشة
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل يمكنك تحديث الكود لاستخدام دينار و فلس .. فلس العشري 3 .. يعني أنه يحتوي على مئات وعشرات وآحاد ..
شكرا لك ..
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا نسيم ،
ربما يمكن أن يساعد رمز VBA الموجود في الصفحة التالية.
تحويل الأرقام إلى كلمات باستخدام دينار و فلس.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكراً جزيلاً ..
يمكنك تحديث لكتابة يملأ في رقم وليس كلمة.
125.100 -> مائة وخمسة وعشرون دينار كويتي و 100 فلس فقط

شكر
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا بالمساعدة ، أنا أحب صيغتك ولكني أرغب في تحديث الصيغة بحيث تظل مثل المثال بالأحرف الكبيرة. شكرًا جزيلاً.
على سبيل المثال:
121,500.56،XNUMX دولارًا أمريكيًا = مائة وواحد وعشرون ألفًا وخمسمائة وستة وخمسون سنتًا
*** واحد وعشرون ألف وخمسمائة و 56/100 دولار أمريكي

121,500.00،XNUMX دولار أمريكي = مائة وواحد وعشرون ألف وخمسمائة دولار ولا سنتات
*** واحد وعشرون ألف وخمسمائة و 00/100 دولار أمريكي
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا يا ملاك،
يمكن أن يقدم لك رمز VBA التالي خدمة. بعد إضافة الكود إلى ملف وحدة (كود) نافذة او شباك. لا تنس تطبيق هذه الصيغة = NumberstoWords (خلية) للحصول على النتيجة.
Function NumberstoWords(ByVal pNumber)
'Updated by Extendoffice 20221123
Application.Volatile

Dim Dollars, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")

If xDecimal > 0 Then
    Cents = Left(Mid(pNumber, xDecimal + 1) & "00", 2)
    Cents = "AND " & Cents & "/100 US DOLLARS"
    pNumber = Trim(Left(pNumber, xDecimal - 1))
Else
    Cents = "AND " & "00/100 US DOLLARS"
End If


xIndex = 1
Do While pNumber <> ""
    xHundred = ""
    xValue = Right(pNumber, 3)
    If Val(xValue) <> 0 Then
        xValue = Right("000" & xValue, 3)
        If Mid(xValue, 1, 1) <> "0" Then
            xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
        End If
        If Mid(xValue, 2, 1) <> "0" Then
            xHundred = xHundred & GetTens(Mid(xValue, 2))
        Else
            xHundred = xHundred & GetDigit(Mid(xValue, 3))
        End If
    End If
    If xHundred <> "" Then
        Dollars = xHundred & arr(xIndex) & Dollars
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop
Select Case Dollars
    Case ""
        Dollars = "No Dollars"
    Case "One"
        Dollars = "One Dollar"
    Case Else
        Dollars = Dollars
End Select
NumberstoWords = UCase(Dollars & Cents)
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
    Select Case Val(pTens)
        Case 10: Result = "Ten"
        Case 11: Result = "Eleven"
        Case 12: Result = "Twelve"
        Case 13: Result = "Thirteen"
        Case 14: Result = "Fourteen"
        Case 15: Result = "Fifteen"
        Case 16: Result = "Sixteen"
        Case 17: Result = "Seventeen"
        Case 18: Result = "Eighteen"
        Case 19: Result = "Nineteen"
        Case Else
    End Select
Else
Select Case Val(Left(pTens, 1))
    Case 2: Result = "Twenty "
    Case 3: Result = "Thirty "
    Case 4: Result = "Forty "
    Case 5: Result = "Fifty "
    Case 6: Result = "Sixty "
    Case 7: Result = "Seventy "
    Case 8: Result = "Eighty "
    Case 9: Result = "Ninety "
    Case Else
End Select
Result = Result & GetDigit(Right(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
    Case 1: GetDigit = "One"
    Case 2: GetDigit = "Two"
    Case 3: GetDigit = "Three"
    Case 4: GetDigit = "Four"
    Case 5: GetDigit = "Five"
    Case 6: GetDigit = "Six"
    Case 7: GetDigit = "Seven"
    Case 8: GetDigit = "Eight"
    Case 9: GetDigit = "Nine"
    Case Else: GetDigit = ""
End Select
End Function
لا توجد تعليقات منشورة هنا حتى الآن
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL