معادلات الى كود

[الشيباني1]

اخواني الاعزاء تحية طيبه في المرفق معادلات مؤشرة بارقام ومثبته في مرفق آخر.

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

معادلات الى كود.zip

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

السلام عليكم

Private Sub Worksheet_Change(ByVal Target As Range)

On Error Resume Next

Dim R As Integer

If Not Intersect(Target.Cells(1, 1), Union(Range("D18:D39"), Range("F18:F39"), Range("O18:O39"))) Is Nothing Then

    R = Target.Row

    If Cells(R, "D").Value <> "" Then

        Cells(R, "C").Value = R - 17

        Cells(R, "G").Value = Val(IIf(Cells(R, "O") <> "", Cells(R, "O"), Cells(R, "N")))

        Cells(R, "H").Value = Val(Cells(R, "F")) * Val(Cells(R, "G"))

        Cells(R, "N").Value = WorksheetFunction.VLookup(Cells(R, "D"), [prices], 3, 0)

        Cells(R, "P").Value = WorksheetFunction.VLookup(Cells(R, "D"), [prices], 4, 0)

        Cells(R, "Q").Value = (Val(Cells(R, "G")) - Val(Cells(R, "P"))) * Val(Cells(R, "F"))

    Else

        Union(Cells(R, "C"), Cells(R, "H"), Cells(R, "N"), Cells(R, "P"), Cells(R, "Q")).ClearContents

    End If


End If

On Error GoTo 0

End Sub

[الشيباني1]

استاذنا العزيز احييك واشكرك جدا على هذا الكود الرائع ادامك الرحمن لنا منقذا

[الشيباني1]

الاخوة الاعزاء تحية طيبه جاد استاذنا الكبير عبد الله باقشير بالكود الرائع الذي تتضمنه المشاركه هذه والذي لبى حاجتي كثيرا ، ارجو (ان كان ذلك ممكنا) تضمين المعادلات المؤشره بالاصفر في الملف المرفق بنفس الكود او آخر مع الامتنان

معادلات الى اكواد2.zip

[الشيباني1]

اخواني الاعزاء لا زلت منتظرا لأني لن يخيب بأذن الله ظني

مع الامتنان