اذهب الي المحتوي
أوفيسنا

كود لتحويل المعادلات الى قيم


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

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

شهر مبارك وكل عام وانتم بخير

كود لتحويل المعادلات الى قيم


Option Explicit



Sub Kh_Formula_To_Value()

Dim MyCalcu As XlCalculation

With Application

    MyCalcu = .Calculation

    .Calculation = xlCalculationManual

    .ScreenUpdating = False

End With

'=====================================

'//////////////////////////////////////

'=====================================

'  هنا تضع النطاق والمعادلة التي تريد تحويلها قيم

'      Formula_To_Value باستخدام

'=====================================

' T هنا المعادلة اللي في العمود

Formula_To_Value Range("T5:T30"), "=RC[-2]*RC[-1]"


' x هنا المعادلة اللي في العمود

'  مثل عمل كود الاخ كيماس


Formula_To_Value Range("X5:X30"), "=IF(COUNTIF(RC16:R30C16,RC16)=1,SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20)),"""")"


' Y هنا المعادلة اللي في العمود

Formula_To_Value Range("Y5:Y30"), "=SUMPRODUCT((R5C16:R1500C16=RC16)*(R5C20:R1500C20))"

'=====================================

'//////////////////////////////////////

'=====================================

With Application

    .ScreenUpdating = True

    .Calculation = MyCalcu

End With


End Sub

=================================================


Sub Formula_To_Value(MyRng As Range, MyFormula As Variant)

With MyRng

    .ClearContents

    .Formula = MyFormula

    .Cells = .Value

End With

End Sub

وهو طلب احدهم في الموضوع

http://www.officena.net/ib/index.php?showtopic=37827

المرفق ملف اكسل 2003

كود تحويل المعادلات الى قيم.rar

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

السلام عليكم

استسمحك استاذي في رفع الكود الى موضوع الاكواد المنفصلة.

تفضل بدون اذن

وتشكر على هذا الجهد الملحوظ

بارك الله فيك وكل عام وانتم بخير

كنت اتمنى ان اكون اول المعبرين عن اعجابى بهذا العمل العظيم .

وكانك كذلك

حفظك الله ورعاك

وكل عام وانتم بخير

تقبلا تحياتي وشكري

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

السلام عليكم

بارك الله فيك أستاذنا خبور

و كل عام أنتم بخير

الاخ الحبيب كيماس -----حفظه الله

لم اشاهد ردك هذا اثناء ردي السابق

جزاك ربي خيرا

وشهر مبارك وكل عام وانتم بخير

تقبل تحياتي وشكري

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

الاستــــــــــــــــاذ الكبير 

خبــــور خيــــر

كما قال استاذنا الحســـامي ملف اكثر من رائع

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

وفقك الله ... ويسر امرك

ياسر الحافظ

ابو الحارث

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

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

أخي خبور كل عام و انت بخير

و جزاك الله خير على هذا الكود الجميل

و كإضافة

أنا أقوم بإستخدام هذا الكود لتحويل المعادلات الى قيم



Sub FormulaToValue()

With ActiveSheet.Cells

    .Copy

    .PasteSpecial xlValues

End With

End Sub


فلربما فكرته تساعد الأخوة أيضاً في الحصول على طرق أخرى

===============

دمتم في حفظ الله

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

و للتجميع

هذه طريقة أخرى فعالة

=

نعم أستاذ

بارك الله فيك

الخاصية evaluate

تقوم بتقييم أى معادلة

يعنى لو عندك معادلة شغالة بدون مشاكل فى الشيت

يمكنك تقييمها من خلال الكود باستخدام evaluate

و تقييمها معناه حسابها

و إرجاع قيمتها النهائية " القيمة و ليس المعادلة

كما شاهدت فى ملفك

بشرط ألا تزيد حروفها على 255 حرفا

أيضا لا نضع علامة "=" معها

هكذا

Range("x5") = Application.Evaluate("SUMPRODUCT((P5:P1500=P5)*(T5:T1500))"

و هذه الخاصية مشابهة لخاصية calculate

=

هذا المطلوب بسطر واحد من الكود

وبدون أن تظهر المعادلة أصلا فى الخلية

درة غالية

لكن ما تغلى عليكم

كل عام أنتم بخير

أخى ضع السطر التالى فى حدث نقر الزر

Range("x5") = Application.Evaluate("SUMPRODUCT((P5:P1500=P5)*(T5:T1500))")

كما يمكنك استخدام دالة sum

هكذا

Range("x5") = Application.Evaluate("SUM((P5:P1500=p5)*T5:T1500)")

رابط المشاركة

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

  • 7 months later...
  • 1 year later...

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

اخي العزيز  sarab1618

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

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

واضف اي معلومات اخرى في الخلايا الصفراء وما تحتها الى 300 صف واضغط على الزر سيقوم بدمج الاسماء

تقبل فائق احترامي وتقديري

 

انتاج الاسم الثلاثي.rar

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

الف شكر أخ عباس ...

لكن لدي استفسارين اثنين :

1 - المعادلة المرفقة مع الموديول لا تترك فراغ بين الخلايا المراد دمجها

2 - هل يمكن جهل الموديول يعمل بشكل تلقائي بمجرد ادخال الخلايا الثلاثة الاولى ويقوم مباشرة بعملية الدمج

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

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

الاخ العزيز شكرا لك وبارك الله فيك

اما المعادلة لاتترك فراغات هذا صحيح ادرجت المعادلة بهذا الشكل(=A2&"  "&B2&"  "&C2) لترك مسافة بين الاسماء  وهي تعمل تمام كمعادلة في الشيت  لكن حين ادراجها في الكود يعترض ويظهر خطا ولا اعلم مالسبب وحاولت عدة مرات لكن لم تفلح محاولتي ارجو ان يتدخل احد الاساتذة للتعديل متفضلا وله دعواتنا بالصحة والعافية

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

او يقوم احد الاساتذة الكرام وهم ما شاء الله تبارك الرحمن لهم خبرة كبيره والامر لهم بذلك جزاهم الله خيرا

تقبل فائق احترامي وتقديري

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

السلام عليكم

 

الشكر واصل لاخي الحبيب عباس السماوي ..........حفظه الله

 

المعادلة المرفقة مع الموديول لا تترك فراغ بين الخلايا المراد دمجها

 

 

استبدل الجزء هذا من الكود

Formula_To_Value Range("d2:d300"), "=A2&"" ""&B2&"" ""&C2"

في امان الله

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

  • 7 months later...

السلام عليكم 

 

اود تحويل المعادلتين الموضحين الى كود ماكرو يرتبط فيما بعد بزر مخصص لهم 

المعادله الاولى :                    (VLOOKUP([@CODE],sheet1!A:D,4,0=

المعادله الثانيه :                     [@QTY]-[@Column1]=

 

 

لقد طرحت الطلب فى موضوع منفصل ولكن لا يوجد اى حل 

 

ارجو مساعدتى عاجلاً لحاجتى الى هذا الطلب 

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

  • 6 months later...

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information