معادلة المدين والدائن للرصيد

[أبو شرف]

السلام عليكم 

اخواني اعضاء المنتدى . المرفق في الملف هو عامود الرصيد ومطلبي في حالة الرصيد مدين بذهب الى رصيد الدين وفي حالة دائن بذهب الرصيد الى العامود الدائن والمرفق موضح به كل شيء 

مع التقدير 

اخوكم 

 ابو شرف

كشف حساب مدين ودائن.rar

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

جرب هذا الماكرو

Option Explicit
Sub MoudinDa7en()
Dim Final_row%
Dim My_rg As Range
Dim my_sum#
Dim i%
i = 1
Final_row = Cells(Rows.Count, 2).End(3).Row
Set My_rg = Range("e2:e" & Final_row)
 Do Until My_rg.Cells(i) = vbNullString
 On Error Resume Next
   If Not IsNumeric(My_rg.Cells(i)) Then My_rg.Cells(i) = 0
    Select Case My_rg.Cells(i)
     Case Is < 0
     My_rg.Cells(i).Offset(0, -1) = My_rg.Cells(i)
     Case Is > 0
     My_rg.Cells(i).Offset(0, -2) = My_rg.Cells(i)
       End Select
       i = i + 1
  Loop

End Sub

 

[أبو شرف]

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

جرب هذا الماكرو

Option Explicit
Sub MoudinDa7en()
Dim Final_row%
Dim My_rg As Range
Dim my_sum#
Dim i%
i=1
Final_row = Cells(Rows.Count, 2).End(3).Row
Set My_rg = Range("e2:e" & Final_row)
 Do Until My_rg.Cells(i) = vbNullString
 On Error Resume Next
 
   If Not IsNumeric(My_rg.Cells(i)) Then My_rg.Cells(i) = 0
    Select Case My_rg.Cells(i)
     Case Is < 0
     My_rg.Cells(i).Offset(0, -1) = My_rg.Cells(i)
     Case Is > 0
     My_rg.Cells(i).Offset(0, -2) = My_rg.Cells(i)
       End Select
       i = i + 1
  Loop

End Sub

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

[ابراهيم الحداد]

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

ضع المعادلة الاولى فى لبخلية "E2" ثم اسحب نزولا

=IF([@مدين]>[@دائن];[@مدين]-[@دائن];0)

ثم ضع المعادلة التالية فى الخلية "F2" ثم اسحب نزولا

=IF([@دائن]>[@مدين];[@دائن]-[@مدين];0)

 

[أبو شرف]

استاذي الغالي اشكرك  جدا . ولكن المعادلة مش راضية تركب وتشتغل . ممكن تركبها على الملف واكون ممنون منك . مع فائق التقدير 

[ابراهيم الحداد]

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

تفضل

 

 

كشف حساب مدين ودائن.rar

[Ali Mohamed Ali]

 

الشكر دائما لأستاذنا الكبير زيزو

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

ويارب دائما أستاذ سليم تبهرنا بأكوادك الرائعة الى الأمام دائما-جزاكم الله خيرا

 

[أبو شرف]

بارك الله فيك استاذنا العزيز وحقيقة شيء مبهر . حفظكم الله وبارك بصحتكم 

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

لم افهم في البداية ما هو المطلوب

لذلك هذا التعدبل على الكود

Sub MoudinDa7en()
Dim Final_row%
Dim My_rg As Range
Dim i%
i = 1
Final_row = Cells(Rows.Count, 2).End(3).Row
Set My_rg = Range("c2:c" & Final_row)
  
  Do Until My_rg.Cells(i) = vbNullString
   With My_rg.Cells(i)
       On Error Resume Next
    If Not IsNumeric(.Value) Then .Value = 0
         If .Value - .Offset(, 1) > 0 Then
              .Offset(, 2) = .Value - .Offset(, 1)
              .Offset(, 3) = 0
         Else
              .Offset(, 3) = Abs(.Value - .Offset(, 1))
              .Offset(, 2) = 0
         End If
      i = i + 1
   End With
  Loop

End Sub