طلب تعديل على الكود المرفق لإستخراج الرصيد

[أبو العاصم]

السلام عليكم ورحمة الله الكود المرفق هو الكود الوحيد الذى إهتديت اليه لعمل الترصيد أطلب تعديل عليه بحيث يكون الرصيد فى عمود واحد فقط بحيث لو الصيد قلب سالب يدرج الرصيد بالسالب ولو فى الإمكان الوصول الى كود جديد يقوم بنفس الفكرة يغير كل أرقامه أتوماتيك بمجرد تغيير أى عمليه سابقه أكون شاكر جدا الكود Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("E9:E20")) Is Nothing Then '--------------------------- If Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False aa = Application.Sum(Range("E9:E20")) bb = Application.Sum(Range("F9:F20")) If aa - bb + [A9] > 0 Then Target.Offset(0, 2) = aa - bb + [A9] If aa - bb + [A9] < 0 Then Target.Offset(0, 3) = aa - bb + [A9] If aa - bb + [A9] = 0 Then Target.Offset(0, 2) = 0 Target.Offset(0, 3) = 0 End If End If If Not Intersect(Target, Range("F9:F20")) Is Nothing Then '--------------------------- If Target.Cells.Count > 1 Then Exit Sub Application.ScreenUpdating = False aa = Application.Sum(Range("E9:E20")) bb = Application.Sum(Range("F9:F20")) If aa - bb + [A9] > 0 Then Target.Offset(0, 1) = aa - bb + [A9] If aa - bb + [A9] < 0 Then Target.Offset(0, 2) = aa - bb + [A9] If aa - bb + [A9] = 0 Then Target.Offset(0, 1) = 0 Target.Offset(0, 2) = 0 End If End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) End Sub المرفق به الكود القديم وتعديلى عليه

ترصيد.rar

[أبو العاصم]

اين الفارس ياسر خليل

[أبو العاصم]

up