اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

ماكرو لتحويل النص الى رقم


الردود الموصى بها

بسم الله الرحمن الرحيم

الاخوة الكرام

السلام عليكم ورحمة الله وبركاته

وجدت برنامج رائع جدا لتصدير جداول واستعلامات بالاكسيس الى شيت اكسيل والبرنامج اكثر من رائع فعلا وهو عىل الرايط التالي

http://www.officena.net/ib/topic/58001-منقول-هدية-برنامج-تصدير-بيانات-من-جداولاستعلامات-اكسس-الى-اكسل

المشكلة التي واجهتني انه يوجد حقول نصية بالجدول وتحتوي على ارقام وهذا لفائدة هامة لي في البرنامج المشكلة انه عند تصدير البيانات تظهر مشكلة في الاكسيل رسالة تطلب تحويل القيمة الى رقم وهذا ما احتاجه فعلا في عملية تجميع

 

009.thumb.png.fb888fdffef372458137659641

 

اريد ان اصمم ماكرو او كوج برمجي يقوم بتحويل كل محتويات الورقة الى رقم لتفادي اخطاء الجمع التي اريد تنفيذها ان شاء الله

ارجو ان اكون قد وضحت المشكلة بصورة جيدة

والشكر للجميع مقدما

والسلام عليكم ورحمة الله وبركاته

رابط هذا التعليق
شارك

أخي الكريم ارفق الملف المراد العمل عليه ..

جرب الكود التالي عله يفي بالغرض

Sub ConvertTextToNumber()
    Dim R As Range
    On Error Resume Next
    For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
        If IsNumeric(R) Then R.Value = Val(R.Value)
    Next R
End Sub

 

  • Like 1
رابط هذا التعليق
شارك

جزاك الله خيرا استاذ ياسر ولو امكن كيف تنفيذ الكود بزر امر او عند فتح البرنامج تلقائيا واعذرني لان خبرتي ضعيفة في الاكسيل

مرفق الملف ولك الشكر

تحياتي

00101.rar

رابط هذا التعليق
شارك

أخي الكريم محمد

يرجى تغيير اسم الظهور للغة العربية

إليك الملف المرفق فيه تطبيق الكود ..

 

Convert Text To Numbers YK.rar

  • Like 2
رابط هذا التعليق
شارك

جزاك الله خيرا استاذي الفاضل

هذا هو المطلوب بالضبط

ولو تتكرم علي بشرح كيفية وضع زر في الشيت وربطه بالكود السابق

دمت لاخيك

تحياتي

تم تعديل بواسطه Mo7med
رابط هذا التعليق
شارك

  • 3 weeks later...

أخي الكريم المراغي

إليك الكود التالي ..جربته على ملفك ويعمل بشكل جيد جداً

Sub ConvertTextToNumber()
    Dim R As Range, WS As Worksheet
    On Error Resume Next
    Application.ScreenUpdating = False
        For Each WS In ThisWorkbook.Sheets
            For Each R In Sheet1.UsedRange.SpecialCells(xlCellTypeConstants)
                If IsNumeric(R) Then R.Value = Val(R.Value)
            Next R
        Next WS
    Application.ScreenUpdating = True
End Sub

 

رابط هذا التعليق
شارك

بارك الله فيك استاذ ياسر

جربت الكود ولم يقم بتحويل الحقول النصية الى رقمية

برجاء التجربة مرة اخرى ...

بانتظارك استاذ الفاضل

تحياتي

 

رابط هذا التعليق
شارك

في ٢٧‏/١٠‏/٢٠١٥ ١:٤٩:١٤, ياسر خليل أبو البراء said:

أخي الكريم محمد

يرجى تغيير اسم الظهور للغة العربية

إليك الملف المرفق فيه تطبيق الكود ..

 

Convert Text To Numbers YK.rar

السلام عليكم ..

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

جزاكم الله خيراً ...أخي الحبيب أبو البراء..

  • Like 1
رابط هذا التعليق
شارك

هاتفضل طول عمرك تبهرنى بكل ما تقدمه من أعمال فى غاية الروعة أستاذى القدير / ياسر خليل

زادك الله من فضلة وعلمه

 

  • Like 1
رابط هذا التعليق
شارك

أخي الكريم المراغي

وضح المشكلة بشكل أكثر تفصيل ..يعني اذكر خلايا محددة لم يتم فيها التحويل .. جرب دالة الجمع مع الخلايا التي تقصدها أولاً وشوف هل يتم جمعها أم لا؟

ارفق ملفك بعد تنفيذ الكود ...

كما يرجى ذكر نسخة الاوفيس التي تعمل عليها ؟؟

 

رابط هذا التعليق
شارك

جزاك الله خيرا استاذي الفاضل

الكود والحمد لله يعمل بشكل صحيح والمشكلة كانت عندي انا ...

ولك وافر التحية

رابط هذا التعليق
شارك

لم توضح أخي الكريم المراغي المشكلة التي كانت لديك

يرجى طرحها والخطوات التي قمت بها للوصول للحل ..ليستفيد الجميع في حالة حدوث مثل تلك المشكلة

تقبل تحياتي

رابط هذا التعليق
شارك

السلام عليكم

مرحبا استاذي الفاضل ياسر

المشكلة التى كانت عندي لدي عمود يقوم بغمل ترتيب حسب المجموع وفي المثال المرفق عمود Fo

فعند تشغيل الماكرو وفي نفس الوقت يقوم عمود Fo بالترتيب تحدث المشكلة ويعلق الجهاز

فقمت بالغاء العمود Fo لحل المشكلة

ولو ان هناك حل افضل يكون لكم جزيل الشكر

دمتم بود

تحياتي

Convert Text To Numbers YK.rar

رابط هذا التعليق
شارك

جرب التعديل التالي حيث أضفت سطر يعطل الحساب التلقائي إلى حين انتهاء عمل الكود ثم بعد انتهاء الكود يتم تفعيل الحساب التلقائي مرة أخرى ..

جرب وأعلمني بالنتيجة

Sub ConvertTextToNumber()
    Dim R As Range
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
        For Each R In ActiveSheet.UsedRange.SpecialCells(xlCellTypeConstants)
            If IsNumeric(R) Then R.Value = Val(R.Value)
        Next R
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
    MsgBox "Done!", 64
End Sub

تقبل تحياتي

 

  • Like 2
رابط هذا التعليق
شارك

الله يصلح حالك ويهديك الى الجنة استاذ ياسر

الكود الجديد ما شاء الله يعمل بكفاءة وسرعة

فجزاك الله خيرا

دمت بكل خير

تم تعديل بواسطه المراغي
  • Like 1
رابط هذا التعليق
شارك

الحمد لله الذي بنعمته تتم الصالحات

وجزيت خيراً بمثل ما دعوت أخي المراغي .. وإن شاء الله ستجد المساعدة من إخوانك بالمنتدى دائماً

تقبل تحياتي

  • Like 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information