ميزان مراجعة بالكودات

[أنس دروبي]

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

أحبابي في الله منذ فترة كنت قد عرضت طلب وفكرة ميزان مراجعة بالكود وليس بمعادلة sumif

رابط الموضوع

http://www.officena.net/ib/topic/61931-ميزان-مراجعة-بالأرصدة-بالكودات-وليس-معادلة-sumif/#comment-400612

فكان المجيب على الفكرة والمبدع في طرح الحل أخي وحبيبي الأستاذ ياسر خليل أبو البراء

ولكن بعد انزال البيانات وكبرها مع الزمن اصبح الكود يأخذ وقت كبير في التنفيذ 

فعدلت في كود مشابه لكود الاستاذ ياسر يعطي النتائج بناء على تاريخين (تاريخ بداية-تاريخ نهاية) والكود هو عبارة عن معادلة sumif ولكن عن طريق الكود

ايضاُ مع كبر البيانات وضخامتها اصبح الكود الذي عدلته يأخذ وقت اكبر من الكود الأول

علماً للمعلومة :

عدد اسطر البيانات حوالة 8000 الف سطر في ورقة دفتر اليومية

وعدد الحسابات تقريباً 1000 حساب في ورقة ميزان المراجعة

مواصفات الجهاز الذي يوجد فيه الملف : hp core i5 /ram:8 gig

كود الاستاذ ياسر:اعطى المطلوب بعد (9) ثواني بالظبط 

الكود الذي عدلت فيه:اعطى المطلوب بعد (11) ثواني بالظبط

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

علماً عدد البيانات كبير جداً ولكن هذا الملف فقط للتجربة

المطلوب في الملف المرفق شاهدو الطريقة

نسأل الله عزوجل ان يكون هذا الموقع المتميز ساعياً في نشر العلم والمعرفة دائماً

والسلام عليكم

 

 

 

 

 

 

 

ميزان المراجعة بالكود.rar

[الصـقر]

الاخ الكريم

نظر لضيق الوقت لدى  ارجوا المعذره لكن بدلك على فكره قد تفيدك

جرب الاتى

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
With Sheet1
.Select
 lr = .Range("b100000").End(xlUp).Row
With Sheets("ميزان المراجعة").Range("e8:e" & lr)
.Formula = "=SUMIFS(قم بتكملة المعادله الازمه
 .Value = .Value
End With
With Sheets("ميزان المراجعة").Range("f8:f" & lr)
.Formula = "=SUMIFS(قم بتكملة المعادله اللازمه
.Value = .Value
End With
End With
Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   Application.EnableEvents = True
   Application.Calculation = xlCalculationAutomatic

هذه الطريقه بنظرى افضل الطرق فهى غير مستخدم فيها حلقات تكراريه ومجربه عندى بالبرنامج والسرعه فوق  الخيال

ارجوا منك المعذرة وتقبل تحياتى

تم تعديل سبتمبر 1, 2015 بواسطه الصـقـر

[أنس دروبي]

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

علماً المعادلة اعطت الناتج الصحيح عند كتابتها كمعادلة في الخلايا

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

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

ومن لديه فكرة اخرى يرجى عرضها لإثراء الموضوع 

 

ميزان المراجعة بالكود.rar

[الصـقر]

اخى الكريم

تفضل المرفق

تم تعديل المعادله جرب وعلمنى بالنتيجة الصراحه عندى فى ممتازه تم لصق المعادلات على 1000 صف وتحويل الصيغه الى قيمه حتى لا يتسبب فى ثقل للشيت

تقبل تحياتى

 

 

ميزان المراجعة بالكود.zip

تم تعديل سبتمبر 2, 2015 بواسطه الصـقـر

[أنس دروبي]

الله يبارك فيك اخي الصقر 

صحيح هذا هو المطلوب وكان في ظرف قياسي 

اخذ تنفيذ الكود (4) ثواني تقريباً

لكن هل توجد طريقة أخرى تقوم بالمطلوب ولكن بظرف قياسي أكثر 

وهل لمواصفات الكمبيوتر تأثير في هذه القصة 

يعني لو كان الكمبيوتر مواصفاته اقل اوأكثر هل يختلف الوقت في التنفيذ

هل توجد طريقة أخرى غير مبدأ نسخ الصيغة وبعدها تحويلها الى قيم 

تم تعديل سبتمبر 2, 2015 بواسطه أنس دروبي

[الصـقر]

نعم اخى الحبيب مواصفات الجهاز لها تاثير

الكود على جهازى بينفذ فى 2 ثانيه تقريبا

وعموما 4 ثوانى ممتازة ما فيها مشكله

تقبل تحياتى

تم تعديل سبتمبر 2, 2015 بواسطه الصـقـر

[أنس دروبي]

طيب أخي الصقر شكراً وبارك الله فيك على هذه المعلومة 

ولكن ميزان المراجعة هذا مربوط ب(USERFORM) فيحدث بطئ أثناء تنفيذ الكود

وهل إذا كبر عدد اسطر الإدخالات هل تزيد نسبة الوقت في التنفيذ أما تنفيذ الكود مربوط على عدد الحسابات 

قمت بحذف 500 حساب من ورقة ميزان المراجعة فتعدل الوقت بسرعة في التنفيذ فهل كلامي صحيح في هذا السؤال

لأنه موجود اقل شي 2500 حساب نريد تنفيذ حالة الجمع عليهم 

نرجو عرض حل اسرع في التنفيذ

 

[الصـقر]

اخى الحبيب

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

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

فهذا شئ طبيعى ومنطقى وليس عيبا ان يستغرق 10 ثوانى

ونقطه اخرى ميزان المراجعه لا يتم طباعته او معاينه كل دقيقه من قبل المستخدم ممكن مره باليوم فمفيش مشكله من 10 ثوانى لظهور التقرير

 

1- اما بخصوص انه فورم اعتقد لا يختلف تنفيذ الكود بالفورم او على الشيت

وممكن تعمل النتائج على الشيت ومن ثم اليست بالفورم تعمله Row sourse  من الشيت 

2-وبخصوص عدد الادخالات لا تسبب ولا تستغرق وقت لان المعادله تم عملها على 100000 صف فهى تقوم بعمليه الجمع على 100000 الف صف حتى وان كان الخلايا فارغه اما الكود يستغرق وقت على حسب عدد الحسابات المطلوب لصق المعادله بها وليس عدد صفوف الادخال بقاعده البيانات

تقبل تحياتى

 

[أنس دروبي]

الله يبارك فيك اخي الصقر 

شكراً للمعلومة الرائعة هو فقط كنا نريد احترافية وتميز في العمل أكثر

نحنا نسعى لإجبار أكسل على العمل الدائم  والضخم في الحسابات

شكراً لك على الحل وعرض هذه الفكرة الرائعة 

تقبل مروري أخي وحبيبي الصقر

اخوكم انس دروبي

 

[محمد حسن المحمد]

السلام عليكم أخوي الكريمين حسام عيسى /صقر المنتدى و أنس الدروبي

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

  حقيقة أخي الصقر تذكر أني قدمت دراسة عن سند صرف  وقد أخذ جهداً ووقتاً فأقول بنفسي كيف بالذي عمل برنامجاً متكاملاً للمحاسبة؟ ..ولذلك تستحق كل شكر وإعجاب بدراساتك وتقديمك السخي..

 

..تقبلوا مروري والسلام عليكم 

[الصـقر]

استاذى الفاضل

محمد حسن

جزاكم الله خيرا 

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

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

تقبل تحياتى

[محمد حسن المحمد]

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

وهل كان يعلم أولئك العلماء العظماء أن تصل علومهم التي اجنهدوا وجابوا الأرض شرقاً ومغرباً أن تصل إلينا على بساط من ذهب نتناولها كما نتناول كأس الماء

فهناك من يخلد بين الناس بعلمه وحلمه وأدبه وآخرين يموتون فيموت ذكرهم...واجعل ذكرك مرفوعاً بحب الله وطاعته ...فتلك نعم العاقبة ونعم الذكر...تقبلوا تحياتي والسلام عليكم.

[أنس دروبي]

اخي محمد حسن المحمد 

جزاكم الله كل خير على هذه التحية الطيبة 

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

وجامع للمحاسبة التجارية والخدمية والصناعية(اي محاسبة التكاليف) 

منذ 6 اشهر واقوم ببرمجته ولم يكتمل بعد 

هو مجمع كبير لكودات الموقع الذي يطرحه اساتذتنا وعلماءنا الكبار في مجال برمجة أكسل 

اعتمدت فيه البساطة في التصميم وقوة في الاداء 

ان شاء الله متى يكتمل سوف أرفعه اون شاء الله سوف ينال أعجابكم 

البرنامج موجه للمنشأت الصغيرة والمتوسطة 

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

تقبل مروري اخي محمد حسن المحمد

والسلام عليكم 

 

[محمد حسن المحمد]

السلام عليكم أخي الكريم أنس الدروبي

أرجو الله أن يوفقكم لطاعته ومحبته والعمل بمقتضى رضاه وأن ينفع بعلمكم الإسلام والمسلمين

جزاكم الله خيراً والسلام عليكم ..أخوكم أبو يوسف

 

[ياسر خليل أبو البراء]

إخواني الكرام أخي الحبيب حسام عيسى وأنس دروبي وأبو يوسف

بارك الله فيك صقر المنتدى وجزاك الله كل خير

جرب الكود التالي وشوف النتائج صحيحة أم لا .. للتأكد من عمل الكود وجرب سرعة الكود مع بيانات أكثر ..

Sub YasserKhalil()
    Dim Accts As Variant, Data As Variant, Results() As Double
    Dim D1 As Date, D2 As Date
    Dim I As Long, J As Long

    With Sheets("Data")
        Data = .Range("A5", .Range("A" & Rows.Count).End(xlUp)).Resize(, 9).Value
    End With

    With Sheets("Balance")

        Accts = .Range("B8", .Cells(Rows.Count, "B").End(xlUp)).Value
        ReDim Results(1 To UBound(Accts, 1), 1 To 2)
        D1 = .Range("B3").Value
        D2 = .Range("B4").Value

        With CreateObject("Scripting.Dictionary")
            .CompareMode = 1

            For I = 1 To UBound(Accts, 1)
                .Item(Accts(I, 1)) = I
            Next I

            For I = 1 To UBound(Data, 1)
                If .Exists(Data(I, 2)) Then
                    If Data(I, 1) >= D1 And Data(I, 1) <= D2 Then
                        J = .Item(Data(I, 2))
                        If Data(I, 8) <> "" Then Results(J, 1) = Results(J, 1) + Data(I, 8)
                        If Data(I, 9) <> "" Then Results(J, 2) = Results(J, 2) + Data(I, 9)
                    End If
                End If
            Next I
        End With

        .Range("E8:F8").Resize(UBound(Results, 1)).Value = Results
    End With
End Sub

 

ميزان المراجعة بالكود.rar

[أنس دروبي]

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

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

ومن دهشتي في كودك الرائع والاكثر من احترافي في العمل عجز اللسان عن شكرك 

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

تم ربط الكود على 4500 حساب وكان التنفيذ خيالي بكل ماتقوله الكلمة من معنى

شكراً لكم أحبائي....... 

شكراً لك اخي حسام عيسى/ صقر المنتدى على فكرتك الجميلة 

وشكراً لأخي وحبيبي ياسر خليل الذي له افضال عليي في مجال البرمجة من خمس سنوات على هذه الفكرة

اخي ياسر الكود الذي قدمته فهمته بنسبة 50% 

  اقتباس

 With CreateObject("Scripting.Dictionary")
            .CompareMode = 1

            For I = 1 To UBound(Accts, 1)
                .Item(Accts(I, 1)) = I
            Next I

            For I = 1 To UBound(Data, 1)

لوسمحت اتعبتك معاي ان تشرح كيفية عمل الكود باختصار....!

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

http://www.officena.net/ib/topic/63402-ربط-البيانات-في-الليست-بوكس-بعد-التعديل/

وجزاكم الله كل خير

 

تم تعديل سبتمبر 3, 2015 بواسطه أنس دروبي
زيادة

[saad abed]

السلام عليكم

اخى ياسر

اكوادك ثورة في عالم المحاسبة

جزاك الله خيرا

وفقكم الله

[ياسر خليل أبو البراء]

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

الحمد لله الذي بنعمته تتم الصالحات

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

Scripting.Dictionary

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

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

تم تعديل سبتمبر 3, 2015 بواسطه ياسر خليل أبو البراء

[الصـقر]

اخى واستاذى ومعلمى وحبيبى /ياسر خليل

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

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

تقبل منى وافر الاحترام والتقدير والمحبه فى الله