نرجو المساعدة شاكرين مقدما

[habibdar]

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

المطلوب : في المثال المرفق ( مثال توضيحي )  
- لدي صفحة اليومية و فيها بيانات اسم العميل و مبيعات و مقبوضات 
و تتكرر هذه العملية خلال المدة 
- و لدي صفحة الخلاصة 

اريد ان يظهر فقط اسماء العملاء اللذين مجموع المبيعات لهم اكبر او اصغر من مجموع المقبوضات 
يعني ارغب بظهور اسماء العملاء الذين لهم او عليهم ذمة فقط 

شاكرا لكم 

مثال توضيحي.xlsx

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

جرب هذا الكود

Option Explicit

Sub Give_Data()
Dim Dic As Object
Dim i%, Itm, k
Dim max_ro%, Laste_Row%
 
Dim Sh As Worksheet 'source_sheet (Main)
Dim Th As Worksheet ' Target_sheet (Repport)
Set Sh = Sheets("Main"): Set Th = Sheets("Repport")
max_ro = Th.Cells(Rows.Count, 1).End(3).Row

If max_ro = 1 Then max_ro = 2

Th.Range("a2:b" & max_ro).ClearContents
Laste_Row = Sh.Cells(Rows.Count, 1).End(3).Row
    If Laste_Row < 2 Then
      MsgBox "No Data"
      Exit Sub
    End If
Set Dic = CreateObject("Scripting.Dictionary")
 With Dic
      For i = 2 To Laste_Row
          If Sh.Range("B" & i) <> vbNullString Then
               k = Sh.Range("B" & i)
               Itm = Sh.Range("D" & i) - Sh.Range("C" & i)
              If Not .Exists(k) Then
                .Add k, Itm
             Else
               Dic(k) = Dic(k) + Itm
             End If
           End If
      Next i
       Th.Range("A2").Resize(.Count, 1) = Application.Transpose(.keys)
       Th.Range("B2").Resize(.Count, 1) = Application.Transpose(.Items)
 End With
 '===============
 Dic.RemoveAll: Set Dic = Nothing
End Sub

الملف مرفق

Exemple.xlsm

[habibdar]

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

شكرا 

3 دقائق مضت, habibdar said:

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

شكرا 

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

[habibdar]

استاذ سليم تكرمتم علي بكود رائع 
ارجو منكم منحي المزيد من الوقت فلقد ظهر معي متغير اخر و هو نوع العميل ف أحيانا يكون العميل زبون و احيانا يكون شريك 
أرغب بظهر هذه النتائج لعملاء الزبائن فقط 

- قمت بتسمية اسم الصفحات في المثال تماما مثل اسماءها بالملف الاصلي 

- قمت بوضع المعلومات في اعمدتها كما هي متموضعة  في الملف الاصلي 

- قمت باضافة عمود يحدد نوع العميل و الذي احدد فيه ان العميل في هذه الحالة زبون 

شكرا لكم مقدما 

Exemple.xlsm

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

و هل يجوز ان يكون نفس الاسم (زبون و شريك في نفس الوقت) كما هو الحال مع أحمد

 

على كل حال تم التعديل كما تريد

Exemple _New.xlsm

[habibdar]

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

و هل يجوز ان يكون نفس الاسم (زبون و شريك في نفس الوقت) كما هو الحال مع أحمد

 

على كل حال تم التعديل كما تريد

Exemple _New.xlsm 26.74 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 0 downloads

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

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

16 دقائق مضت, habibdar said:

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

تم معالجة الأمر والملف في المشاركة 

Exemple _New.xlsm

[وجيه شرف الدين]

الله عليك استاذ سليم والله مبدع دائما

[habibdar]

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

تم معالجة الأمر والملف في المشاركة 

Exemple _New.xlsm 26.74 \u0643\u064a\u0644\u0648 \u0628\u0627\u064a\u062a · 1 download

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

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

المشكلة بسيطة جداً 

يمكن معالجتها باضافة سطر  واحد على الكود

( ما هو موجود بين علامات +++++++) ليصبح الكود بهذا الشكل

Option Explicit

Sub Give_Data()
Dim Dic As Object
Dim i%, Itm, k
Dim max_ro%, Laste_Row%
Dim Sh As Worksheet 'source_sheet (acc)
Dim Th As Worksheet ' Target_sheet (net)
Set Sh = Sheets("acc"): Set Th = Sheets("net")
max_ro = Th.Cells(Rows.Count, 1).End(3).Row

If max_ro = 1 Then max_ro = 2

Th.Range("a24:b" & max_ro).ClearContents
Laste_Row = Sh.Cells(Rows.Count, "H").End(3).Row
    If Laste_Row < 2 Then
      MsgBox "No Data"
      Exit Sub
    End If
Set Dic = CreateObject("Scripting.Dictionary")
 With Dic
      For i = 2 To Laste_Row
          If Sh.Range("H" & i) <> vbNullString _
           And Sh.Range("F" & i) = Th.Range("d1") Then
               k = Sh.Range("H" & i)
               Itm = Sh.Range("C" & i) - Sh.Range("E" & i)
              If Not .Exists(k) Then
                .Add k, Itm
               Else
               Dic(k) = Dic(k) + Itm
              End If
           '++++++++++++++++++++++++++++++++++++
              If Dic(k) = 0 Then .Remove k
           '++++++++++++++++++++++++++++++++++++
          End If
      Next i
       Th.Range("A24").Resize(.Count, 1) = Application.Transpose(.keys)
       Th.Range("B24").Resize(.Count, 1) = Application.Transpose(.Items)
 End With
 '===============
 Dic.RemoveAll: Set Dic = Nothing
End Sub

الملف مرفق

 

 

Exemple _New_sans_Zero.xlsm

[habibdar]

شكرا لكم استاذي العزيز 
كل شئ يعمل بشكل ممتاز 
لكم منا كل الاحترام 

J'espère communiquer avec vous directement
Pour voir le fichier original
Habib