المساعدة في طريقة لعمل المعادلة آليا بالكود

[أبو أنس حاجب]

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

المطلوب كود يقوم بعمل المعادلة الموجودة في الخلية J3 في الخلية اسفل منها آليا بمجرد ادخال رقم الحساب وهكذا اسفل فاسفل وفي حالة مسح البيانات من عمود رقم الحساب يقوم بحذف جميع المعادلات المخلقة باستثناء الخلية المذكورة اعلاه

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

ولكم الشكر والتقدير

اخوكم أبو أنس

[أبو أنس حاجب]

ارجو المعذرة هذا الملف المرفق

تخليق معادلة بالكود.rar

[الـعيدروس]

السلام عليكم

تفضل هذا الكود

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Or Target.Row < 3 Then Exit Sub

If Target.Value = Empty Then Target.Offset(0, 9).Value = Empty: Exit Sub

If Not Intersect(Target, Range("A3:A2000")) Is Nothing Then

Target.Offset(0, 9).FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-9],list,2,FALSE)),"""",VLOOKUP(RC[-9],list,2,FALSE))"

Exit Sub

End If

End Sub

وهذا المرفق

وأما كلمة تخليق أراى أن تستخدم غيرها

تركيب أو تأليف هكذا كلمات

والسلام عليكم

تركيب معادلة بالكود_ali.rar

[الـعيدروس]

السلام عليكم

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

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column <> 1 Or Target.Row < 3 Then Exit Sub

If Target.Value = Empty Then Target.Offset(0, 9).Value = Empty: Exit Sub

If Not Intersect(Target, Range("A3:A2000")) Is Nothing Then

For S = 2 To Sheets(2).Range("A15000").Row

If Target.Value = Sheets(2).Cells(S, 1).Value Then

Target.Offset(0, 9).Value = Sheets(2).Cells(S, 2).Value

Exit For

End If

Next S

Exit Sub

End If

End Sub

تم تعديل ديسمبر 16, 2011 بواسطه alidroos

[أبو أنس حاجب]

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

استاذي الفاضل العيدروس

اشكر لك سرعة التجاوب في الرد وبكفاة عالية الله يحفظك واهليك ومن تحب جميعا.

شكرا على تنبيهك بالنسبة لاستخدام الكلمة اعلاه وكنت متشكك في استخدامها ابتداء للشبهه وجزاك الله كل الخير وجنبك كل الشر.

أبو أنس

[الـعيدروس]

وعليكم السلام

الحمد لله انه زبط معاك

ولاشكر على واجب

وفقك الله