كشف حساب من شيت مبيعات العملاء

[ishxp2002]

لدي شيت مبيعات العملاء 

والمطلوب عمل كشف حساب مدين ودائن بحسب اسم العميل وباجمالي قيمة الفاتورة بالمعادلات وليس الاكواد

والملف مرفق 

المبيعات.xlsx

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

جرب هذا الملف  (ربما كان المطلوب)

 

Mabieat.xlsx

[ishxp2002]

استاذ سليم 

لكنك اظهرت اجمالي الرصيد للحركة المدينة او الحركة الدائنة 

المطلوب ان يظهر كشف الحساب على مستوى اجمالي كل فاتورة بحيث الفاتورة الاجلة تظهر في الجانب المدين والفاتورة النقدية تظهر في الجانب الدائن 

وقد اوضحت ذلك في الملف المرسل من قبلك بعد تعديله بالشكل المطلوب .

شاكرا لك سلفا تفاعلك اخي العزيز 

Mabieat.xlsx

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

جرب هذا الملف (الصفحة Target_sh   )

الكود

Option Explicit

Sub Get_data()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
  Dim D As Worksheet, T As Worksheet
  Dim D_Rg As Range, T_rg As Range, Single_rg As Range
  Dim RoD%, RoT%, All_ro%, X%, y%
  Dim Nme$

Set D = Sheets("Data"): Set T = Sheets("Target_sh")
Set D_Rg = D.Range("A4").CurrentRegion
Set T_rg = T.Range("A3").CurrentRegion

RoT = T_rg.Rows.Count
 If RoT > 1 Then _
 T_rg.Offset(1).Resize(RoT - 1).Clear
  If D.FilterMode Then D_Rg.AutoFilter
  RoD = D_Rg.Rows.Count
Set Single_rg = D_Rg.Offset(1).Resize(RoD - 1)


Nme = T.Cells(3, "K")
D_Rg.AutoFilter 4, Nme
D_Rg.AutoFilter 3, "اجل"
  y = D_Rg.SpecialCells(12).Rows.Count
  If y > 0 Then
Single_rg.Columns(2).SpecialCells(12).Copy
T.Range("A4").PasteSpecial (12)
Single_rg.Columns(8).SpecialCells(12).Copy
T.Range("B4").PasteSpecial (12)
End If
D_Rg.AutoFilter
D_Rg.AutoFilter 4, Nme
D_Rg.AutoFilter 3, "نقدا"


X = D_Rg.SpecialCells(12).Rows.Count
If X = 0 Then Exit Sub

Single_rg.Columns(2).SpecialCells(12).Copy
T.Range("C4").PasteSpecial (12)
Single_rg.Columns(8).SpecialCells(12).Copy
T.Range("D4").PasteSpecial (12)

 All_ro = T.Range("A3").CurrentRegion.Rows.Count
   With T.Cells(All_ro + 3, 1)
   .Value = "المجموع:"
   .Offset(, 1) = Evaluate("=SUM(B4:B" & All_ro + 2 & ")")
   .Offset(, 2) = "المجموع:"
   .Offset(, 3) = Evaluate("=SUM(D4:D" & All_ro + 2 & ")")
  End With
  
  With T.Cells(4, 1).Resize(All_ro, 4)
    .InsertIndent 1: .Borders.LineStyle = 1
    .Font.Size = 13: .Font.Bold = True
    .Interior.ColorIndex = 38
  End With
  If D.FilterMode Then D_Rg.AutoFilter
  With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
  End With
End Sub

الملف مرفق

Mabieat_Filter.xlsm

[ishxp2002]

استاذ سليم 

شكري وتقديري لك في متابعة الموضوع -- والنتائح وفق الكود صحيحة 100%

لكن هناك ملاحظتين اساسيتين 

الاولى : المطلوب كان العمل بالمعادلات وليس بالاكواد 

الثانية : النتائج تظهر بشكل تفصيلي على مستوى كل الاصناف داخل الفاتورة والمطلوب ظهور اجمالي قيمة الفاتورة .وبالتالي عدم تكرار رقم الفاتورة  

وبحسب المثال المذكور في الملف