كشف حساب (الدائن - المدين) لكل عميل

طارق منصور · مايو 20, 2021

السلام عليكم ,,,,

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

نأمل المساعدة لعمل كشف حساب (الدائن - المدين) لكل عميل

حسب التاريح

العملاء.xlsm

**سليم حاصبيا** · مايو 20, 2021

حرب هذا الملف

لا ضرورة لادراج اكثر من 700 صف

لان المكرو الذي يعمل على صف واجد يستطيع العمل على الألوف منها

يكفي ادراج نموذح بسيط لما تريد (50 صف كحد أقصى)

كما اني لم أفهم ما هي الحاجة الى اليوزر فورم؟؟؟

Option Explicit
Sub Get_data()
 Dim H As Worksheet
 Dim T As Worksheet
 Dim LrH%, LrT%, i%, Sd#, _
  k%, Se#, My_val#, n%
 
 Dim Date1 As Date, Date2 As Date
 Dim M_date As Date, X_date As Date
 Dim Fr As Range, Wat As Range, Ro1%, Ro2%
 Dim x As Boolean, y As Boolean
 
 Set H = Sheets("Haraka")
 Set T = Sheets("Takrir")
 LrH = H.Cells(Rows.Count, 1).End(3).Row
 LrT = 20
 
 T.Range("D5").Resize(LrT, 3).ClearContents
 Date1 = Application.Min(H.Range("C4:C" & LrH))
 Date2 = Application.Max(H.Range("C4:C" & LrH))
 If Not IsDate(T.Range("D2")) Or Not IsDate(T.Range("E2")) Then
  MsgBox "Please Type Dates in D2 and E2"
  Exit Sub
 End If
 M_date = T.Range("D2"): X_date = T.Range("E2")
  If Not IsDate(T.Range("D2")) Or Not IsDate(T.Range("E2")) Then
  MsgBox "Wrong Dates"
  Exit Sub
  End If
  T.Range("D2") = Application.Min(M_date, X_date)
  T.Range("E2") = Application.Max(M_date, X_date)
  
  M_date = T.Range("D2"): X_date = T.Range("E2")
   Set Wat = H.Range("A3:A" & LrH)
  For i = 5 To LrT
    Set Fr = Wat.Find(T.Range("B" & i), lookat:=1)
   If Fr Is Nothing Then GoTo Again
    Ro1 = Fr.Row: Ro2 = Ro1
     Do
      x = H.Range("C" & Ro2) >= M_date
      y = H.Range("C" & Ro2) <= X_date
       If x And y Then
        Sd = Sd + Val(H.Range("D" & Ro2))
        Se = Se + Val(H.Range("E" & Ro2))
        n = n + 1
       End If
        Set Fr = Wat.FindNext(Fr)
        Ro2 = Fr.Row
     If Ro2 = Ro1 Then Exit Do
     Loop
  
  T.Range("D" & i) = IIf(Sd = 0, "", Sd)
  T.Range("E" & i) = IIf(Se = 0, "", Se)
  My_val = Val(T.Range("C" & i)) + Val(T.Range("D" & i)) _
    - Val(T.Range("E" & i))
   T.Range("F" & i) = IIf(My_val = 0, "", My_val)
   T.Range("G" & i) = IIf(n = 0, "", n)
Again:
  Sd = 0: Se = 0: n = 0
  Next i
  
End Sub

T_Mansour.xlsm