جلب ارصدة أرصدة أو حسابات

[samycalls2020]

برجاء مساعدتى فى المرفق .. حفظكم الله

عملاء وأرصده.rar

[samycalls2020]

مرجباً بمشاركتكم

[samycalls2020]

مرجباً بمشاركتكم

[samycalls2020]

للرفع

عام وانتم بخير

[samycalls2020]

للرفع

[samycalls2020]

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

تقبلوا تحياتى

تم تعديل يونيو 29, 2017 بواسطه samycalls2020
تصحيح

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

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

كل عام وانتم بخير

اخى الخزيز موضوعك ليس سهلا و هذا اقصى ماتوصلت اليه

انسخ هذا الكود و الصقه فى موديول جديد  وخصص له زر فى ورقة الاستعلام

Sub Collect3()
  ' جلب بيانات ارصدة العملاء المدينة والدائنة شريطة عدم تساويهما
Dim Arr As Variant, temp As Variant
Dim ws As Worksheet, sh As Worksheet, C As Range
Dim xx As String, y As Long, z As Long, LR As Long, i As Long, p As Long
Set ws = Sheets("الحركة")
Set sh = Sheets("استعلام")
p = 7
xx = sh.Range("E5")
LR = ws.Range("K" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
sh.Range("C8:E" & sh.Range("C" & Rows.Count).End(xlUp).Row).ClearContents
For Each C In ws.Range("K12:K" & LR)
x = WorksheetFunction.CountIf(Range(ws.Cells(12, "K"), C), C)
If x = 1 Then

y = WorksheetFunction.SumIfs(ws.Range("F12:F" & LR), ws.Range("G12:G" & LR), xx, ws.Range("K12:K" & LR), C)
z = WorksheetFunction.SumIfs(ws.Range("H12:H" & LR), ws.Range("I12:I" & LR), xx, ws.Range("K12:K" & LR), C)
If y <> z Then
p = p + 1
sh.Cells(p, "C") = C.Value
sh.Cells(p, "D") = y
sh.Cells(p, "E") = z
End If
End If
Next
Application.ScreenUpdating = True
End Sub

 

[samycalls2020]

الأخ الكريم الأستاذ / زيزو  .. كل التحية والتقدير لشخصكم المحترم

أسعدنى ردكم كثيرا ..

لقد قمت بنسخ الكود .. وبتجريبه كان هناك ملاحظتين هامتين

الأولى : فى حالة التغير من حساب الى عميل واختيار اسم العميل يقوم الكود بكل ضغطه على زر المديول بمسح بيانات الجدول تدريجياً ولا تكون هناك نتيجة غير مسح بيانات الجدول .

الثانية : كما ذكرت لكم أن جدول الحركة حوالى أحد عشر ألف صف , لذلك ظهر بطئ شديد جداً فى التنفيذ

أرجوا منكم استكمال مساعدتكم .. حفظكم الله

[samycalls2020]

الأخ الفاضل الأستاذ / زيزو .. 

أنا فى انتظار ردكم وأرجوا أن يكون لديكم خبر سار بإيجاد حل للملاحظتين المذكورتين.

أو أن تساعدنى بطرح الموضوع على من تراهم اهل للمساعده من أصحاب الخبره

جعلكم الله ممن خصهم بقضاء حوائج الناس

تم تعديل يوليو 1, 2017 بواسطه samycalls2020
تصحيح

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

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

اخى الكريم اكثر من يومين وانا احاول ان اصل الى حل لموضوعك حتى توصلت الى الحل السابق

وقد تم تعديل الكود حتى لا تمسح البيانات اثناء عملية البحث

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

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

و بناءا على هذا الشرط لن تظهر اى بيانات اثناء البحث انك تشترط عدم تساوى المجموعين

و الان اليك الكود بعد التعديل

Sub Collect2()
  ' جلب بيانات ارصدة العملاء المدينة والدائنة شريطة عدم تساويهما
Dim Arr As Variant, temp As Variant
Dim ws As Worksheet, sh As Worksheet, C As Range
Dim xx As String, y As Long, z As Long, LR As Long, i As Long, p As Long
Set ws = Sheets("الحركة")
Set sh = Sheets("استعلام")
p = 7
xx = sh.Range("E5")
LR = ws.Range("K" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
sh.Range("C8:E" & sh.Range("C" & Rows.Count).End(xlUp).Row + 7).ClearContents
For Each C In ws.Range("K2:K" & LR)
If C.Value = xx Then
p = p + 1
sh.Cells(p, "C") = C.Offset(0, -1)
sh.Cells(p, "D") = C.Offset(0, -3)
sh.Cells(p, "E") = C.Offset(0, -5)

End If
Next
Application.ScreenUpdating = True
End Sub

 

[samycalls2020]

السلام عليم ورحمه الله وبركاته

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

أخى الكريم .. استشعر انشغالكم بأسئلة الأعضاء ومساعدتهم , وضيق الوقت لديكم .. كان الله فى عونكم

أخى الكريم ..البحث بالعميل ليس كما ذكرتم بل هو مثل البحث بالحساب وهذا ما شرحته لكم مع الملاحظات بالمرفق فى ورقة توضيح

أرجو سعة الصدر وخذ وقتك كما شئت .. ولكن أرجوا أن لاتنسانى

عملاء وأرصده - 2.rar

[samycalls2020]

أن كان الأمر معقد فنكتفى فقد بالحسابات لتسهيل الأمر وتوفير الوقت

الشرح بالمرفق .. تقبل تحياتى

عملاء وأرصده - 3.rar

[samycalls2020]

خير الناس أنفعهم للناس

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

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

اليك الملف بنفس الكود فى المشاركة الثانية

 

عملاء وأرصده - 3.rar

[samycalls2020]

شكراً لك أخى الفاضل / زيزو

الكود يعمل .. ولكن الشئ الوحيد الذى يشوبه هو البطئ .

تعبتك معايا .. بارك الله فيك