المساعدة بتحويل FUNCTION الى كود

[amir501]

ارجو تحويل دالة FUNCTION الى كود

ارجو مشاهدة المرفق

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

FUNCTION.rar

[عبد الفتاح كيرة]

تفضل الكود التالى

Sub زر1_انقر()

Dim myc As Range

Dim myr As Range

Set myr = Range("c1:c3000")

For Each myc In myr

   If myc.Offset(0, -2) <> "" And myc.Offset(0, -1) <> "" Then

    myc = myc.Offset(0, -2) * myc.Offset(0, -1)

    End If

     Next myc

    Set myr = Nothing

End Sub

المرفقات

Microsoft Excel kemas جديد ??.zip

[amir501]

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

الحمدلله اصبح في كل مشاركة اسم كيماس

دمت تالقا ونورا ومعرفة وزادك الله من علمه ولا حرمنا الله منه

اخوك عامر

[عبد الفتاح كيرة]

الفضل لله أخى

بارك الله فيك

وشكرا على المعلومة الجديدة

وهى أن اسمك عامر

كنت أعتقد أن اسمك أمير

مع الشكر

[دغيدى]

الأخ الفاضل / أبو عمر

دائما فى المقدمة

شكرا لكم

تحياتى

** دغيدى **

[عبد الفتاح كيرة]

حيا الله الأستاذ جمال

نورت الموضوع

أشكرك لشعورك الطيب

[عبدالله باقشير]

السلام عليكم

بارك الله فيك اخي كيماس

تالق ملحوظ

ما شاء الله لا قوة الا بالله

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

[عبد الفتاح كيرة]

حيا الله أستاذى و معلمى

لا تنسى أننا الآن فى عطلة و الوقت سامح

وتوفيق الله من وراء ذلك كله

كم يسعدنى وجودك بالمشاركات

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

تم تعديل يناير 22, 2011 بواسطه kemas

[zine pef]

شكرا لك أخي أمير على الدالة

و شكرا أستاذ كيماس على الكود :clapping:

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

[ابو القبطان]

اخي الحبيب وصديقي المتجدد

واحشني .. واهديك برنامج صغير لأحد اعمدة المنتدى الغائب الحاضر ، اخونا عمر الحسيني " ابوتامر "

يحول اي معادلات لأكواد ، ولكن عليك الحرص واتباع التعليمات ليعمل معك البرنامج ، إقرأ كامل المشاركات .. وإنعم وتمتع بالبرنامج وإدعو لصاحبه

تقبل تحياتي

أخوك : حسن

اليك الرابط

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

[amir501]

hالاخ الاستاذ حسن والله واحشني اتمنى انت تكون بالف خير ارجو منك والاخ الاستاذ كيماس مساعدتني في المرفق

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

myr.rar

[عبد الفتاح كيرة]

غير الكود إلى هذا

Dim myc As Range

Dim myr As Range

On Error Resume Next

 If Not Intersect(Target, Range("a1:b100")) Is Nothing Then

Set myr = Range("c1:c100")

For Each myc In myr

 myc = myc.Offset(0, -2).Value * myc.Offset(0, -1).Value

Next myc

 End If

Set myr = Nothing

[amir501]

ماخاب من صنفك من الخبراء المعتمدين جزاك الله واياه كل خير هل لي بطلب اخير ان جاز لي ذلك

وهو كيف يمكن حساب ضرب عمودين اخرين بنفس الصفحة كما وضحت في المثال السابق مثلا العمود © هو حاصل ضرب (A) (B) اريد ان اجعل مثلا العمود (H) حاصل ضرب (F) و (G) وهكذا اعدل على الكود بحيث يوافي طلبي

تقبل تحياتي وامتناني وشكري لشخصكم الكريم اخ كيماس

[عبد الفتاح كيرة]

تفضل

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myc As Range

Dim myr As Range

On Error Resume Next

 If Not Intersect(Target, Range("a1:b100")) And Intersect(Target, Range("i1:j100")) Is Nothing Then

Set myr = Range("c1:c100")

For Each myc In myr

 myc.Offset(0, 8) = myc.Offset(0, 7).Value * myc.Offset(0, 6).Value

 myc = myc.Offset(0, -2).Value * myc.Offset(0, -1).Value

Next myc

 End If

Set myr = Nothing


End Sub

[دغيدى]

الأخ الفاضل / أبو عمر

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

برجاء تعديل الكود على إن كان العمود A خاليا تكون الإجابة "" أي مرتبط بالعمود A

تحياتى

** دغيدى

[amir501]

جزاك الله كل خير استاذ كيماس والله اعطيت واوفيت دمت ذخرا لمنتدانا الغالي باعظائه وزواره

كل الشكر والامتنان لك ياعملاق المنتدى

تم تعديل يناير 24, 2011 بواسطه amir501

[عبد الفتاح كيرة]

بارك الله فيك أخى

للأستاذ جمال

معذرة لتأخرى بالرد

جرب هذا الكود

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim myc As Range

Dim myr As Range

On Error Resume Next

 If Not Intersect(Target, Range("a1:b100")) And Intersect(Target, Range("i1:j100")) Is Nothing Then

Set myr = Range("c1:c100")

For Each myc In myr

    If myc.Offset(0, -2) = "" Then

         myc.Offset(0, 8) = ""

         myc.Offset(0, 7) = ""

          myc.Offset(0, 6) = ""

 myc = ""


 End If

 myc.Offset(0, 8) = myc.Offset(0, 7).Value * myc.Offset(0, 6).Value

 myc = myc.Offset(0, -2).Value * myc.Offset(0, -1).Value

Next myc

 End If

Set myr = Nothing


End Sub

[دغيدى]

الأخ الفاضل / أبو عمر

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

جزاكم الله على عملكم النافع والف سلام وتحية أرجو أن تنظر لمشاركتى لتساعدنى على الحل

توزيع عشوائى

تحياتى

** دغيدى

تم تعديل يناير 25, 2011 بواسطه دغيدى