كتابة معاله بداخل كود

[ابو حمادة]

تجربة.rar

[سليم حاصبيا]

جرب هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Dim My_Row As Long
Dim m_B, My_range As Range

My_Row = Range("b:B").Find("", after:=Range("b5")).Row - 1

Set m_B = Range("b6:b" & My_Row)

Set My_range = Range("d6:e" & My_Row)
If Intersect(Target, m_B) Is Nothing Then GoTo 1

My_range.Formula = "=IF($B6="""","""",ROUND($C6*d$4,2))"

My_range.Value = My_range.Value
1:
 Application.EnableEvents = True
  Set m_B = Nothing: Set My_range = Nothing
End Sub

 

[ابو حمادة]

7 ساعات مضت, سليم حاصبيا said:

جرب هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
Dim My_Row As Long
Dim m_B, My_range As Range

My_Row = Range("b:B").Find("", after:=Range("b5")).Row - 1

Set m_B = Range("b6:b" & My_Row)

Set My_range = Range("d6:e" & My_Row)
If Intersect(Target, m_B) Is Nothing Then GoTo 1

My_range.Formula = "=IF($B6="""","""",ROUND($C6*d$4,2))"

My_range.Value = My_range.Value
1:
 Application.EnableEvents = True
  Set m_B = Nothing: Set My_range = Nothing
End Sub

 

شكرا استاذي الفاضل لاهتمامك

الكود يعمل جيدا بارك الله فيك وجعله في ميزان حسناتك 

بس فيه ملاحظة ان الكود بيعمل علي  كل الاعمده  يعني بيضيف المعادلة في  النطاق كله كنت محتجها تعمل  لنفس الصف ال  يتم الادخال عليه في العمود (B ) 

[سليم حاصبيا]

اذا كنت تريد ان يعمل على كل صف يمفرده (كي يعمل الكود يجب ان لا تكون الخلية C في نقس الصف فارغة)

اليك هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Intersect(Target, Range("b:b")) Is Nothing Or Target.Row < 6 Then GoTo 1
If Target.Offset(0, 1) = "" Then GoTo 1

Dim My_Row As Long
Dim m_B As Range

My_Row = Target.Row
Set m_B = Target.Offset(0, 2).Resize(1, 2)
m_B.Formula = "=IF($B" & My_Row & "="""","""" ,ROUND($C" & My_Row & "*d$4,2))"
 m_B.Value = m_B.Value
1:
 Application.EnableEvents = True
Set m_B = Nothing
End Sub

 

[ابو حمادة]

6 ساعات مضت, سليم حاصبيا said:

اذا كنت تريد ان يعمل على كل صف يمفرده (كي يعمل الكود يجب ان لا تكون الخلية C في نقس الصف فارغة)

اليك هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

Application.EnableEvents = False
If Intersect(Target, Range("b:b")) Is Nothing Or Target.Row < 6 Then GoTo 1
If Target.Offset(0, 1) = "" Then GoTo 1

Dim My_Row As Long
Dim m_B As Range

My_Row = Target.Row
Set m_B = Target.Offset(0, 2).Resize(1, 2)
m_B.Formula = "=IF($B" & My_Row & "="""","""" ,ROUND($C" & My_Row & "*d$4,2))"
 m_B.Value = m_B.Value
1:
 Application.EnableEvents = True
Set m_B = Nothing
End Sub

 

بجد لسانى عاجز عن الشكر ليك اخي الفاضل واستاذي الغالي

دا المطلوب فعلا الله ينور عليك وجعله في ميزان حسناتك

لي استفسار لو امكن كيفية اضافه معادلات اخرى علما ان الصف سوف يكون به اكثر من 40 معادله بالاعمدة ويوجد معادلات مختلفه عن بعضها البعض فكيف اضيف معادلات اخرى للكود واتمنى لو كان بامكانك شرح الكود لكي اقدر اعمل عليه واضيف المعادلات او تغيير عمود الحدث الذي من خلله يعمل الكود

وهل من الممكن وضع رساله تحزير تفيد بعدم وجود بيانات تظهر فقط في حالة عدم وجود بيانات في الخلية C لنفس الصف 

تم تعديل مايو 30, 2017 بواسطه ابو حمادة

[سليم حاصبيا]

6 ساعات مضت, ابو حمادة said:

بجد لسانى عاجز عن الشكر ليك اخي الفاضل واستاذي الغالي

دا المطلوب فعلا الله ينور عليك وجعله في ميزان حسناتك

لي استفسار لو امكن كيفية اضافه معادلات اخرى علما ان الصف سوف يكون به اكثر من 40 معادله بالاعمدة ويوجد معادلات مختلفه عن بعضها البعض فكيف اضيف معادلات اخرى للكود واتمنى لو كان بامكانك شرح الكود لكي اقدر اعمل عليه واضيف المعادلات او تغيير عمود الحدث الذي من خلله يعمل الكود

وهل من الممكن وضع رساله تحزير تفيد بعدم وجود بيانات تظهر فقط في حالة عدم وجود بيانات في الخلية C لنفس الصف 

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

https://www.youtube.com/watch?v=DCXWHS-BL2w

 

[سليم حاصبيا]

شرح الكود

 

Explain.rar