شرح كود

[mahbob]

السلام عليكم أعضاء ومشرفين منتدانا الغالى
ـــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــــ
الرجاء من سيادتكم شرح لى هذا الكود
وذلك بعد إذن أستاذى الفاضل \ ياسر خليل
الذى أنشأ لى هذا الكود ، ولكن لأنى أعلم أنه مشغول
فرجاء من حضراتكم مساعدتى بدلاً منه فى شرح لى هذا الكود وما يحتويه من أوامر
ولكم منى جزيل الشكر والتقدير

Dim WBK As Workbook
    Dim SH As Worksheet, WS As Worksheet, Cell As Range
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        Set WBK = Workbooks.Open(ThisWorkbook.Path & "\ حسابات العملاء .xlsx")
        
        For Each SH In ThisWorkbook.Sheets
            If SH.Name <> "الفهرس" Then
                SH.Range("C6:F99,H6:I99").ClearContents
                    For Each WS In WBK.Sheets
                        If WS.Name <> "الفهرس الرئيسى" Then
                            With WS
                                If IsEmpty(.Range("A6")) Then GoTo 1
                                For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
                                    If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then
                                        SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value
                                        SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value
                                        SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2)
                                        SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3)
                                        SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value
                                    End If
                                Next Cell
1                             End With
                        End If
                    Next WS
            End If
        Next SH
        WBK.Close SaveChanges:=False
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

[mahbob]

ايه يا جماعه هو الموضوع صعب اوى للدرجة دى ولا ايه ؟

يا مسهل ـــ مستنى ردودكم

   

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

أخي الكريم محبوب

يرجى تغيير اسم الظهور للغة العربية

 

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

يرجى إرفاق ملفك للشرح عليه .. وإن شاء الله تجد من يشرح لك ..

الصبر فقط

[mahbob]

استاذى الفاضل \ ياسر خليل

اسعدنى مرورك الكريم

تقبل منى كل الإحترام والتقدير

جارى رفع ملف مرفق للتوضيح

:
:
:
تحميل الملف

 

هذا هو الكود ، وأأسف لرفعه على موقع خارجى

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

الأخ الفاضل

لم أقصد بالملف المرفق أن تقوم بنسخ الكود في ملف نصي وتضعه ..بل أن ترفق ملف الإكسيل الذي به الكود !!!!

ويرجى ضغط الملف ورفعه على سيرفر المنتدى ..بلاش الروابط الخارجية

راجع التوجيه الثاني عشر

http://www.officena.net/ib/index.php?showtopic=60147

[mahbob]

عذراً أستاذى الفاضل ياسر خليل

وإليك الملف الذى تريده

 

ملفات.rar

 

 

 

[mahbob]

يـــــ ميســر الأحـــوال ـــــــا

     

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

أخي الفاضل محبوب

اعذرني لانشغالي

إن شاء الله غداً سأحاول أن أفرغ بعض وقتي لشرح الكود

ربنا ييسر الأمور

تقبل تحياتي

[mahbob]

أستاذى الفاضل / ياسر خليل

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

واشهد الله أنى اعلم مدى انشغالك

واعلم تمام العلم انك تريد مساعدتى

وانى طرحت الموضوع للاستفاده لى أو لغيرى

لتعم الفائدة على الجميع

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

وفى الاخير تقبل شكرى واعتزازى

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

الأخ الكريم محبوب

أعتذر عن التأخر في الرد عليك ، فقد كنت منشغلاً ..

إليك الشرح عله يفيدك إن شاء الله

Sub YasserKhalil()
'تعريف المتغيرات
    Dim WBK As Workbook
    Dim SH As Worksheet, WS As Worksheet, Cell As Range
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إلغاء خاصية رسائل التنبيه
    Application.DisplayAlerts = False
'سطر لفتح المصنف المسمى حسابات العملاء لجلب البيانات منه
        Set WBK = Workbooks.Open(ThisWorkbook.Path & "\حسابات العملاء.xlsx")
'حلقة تكرارية لكل أوراق العمل في المصنف الحالي الذي يحوي الكود
        For Each SH In ThisWorkbook.Sheets
'سطر لاستثناء ورقة العمل المسماة الفهرس من الحلقة التكرارية
            If SH.Name <> "الفهرس" Then
'مسح محتويات النطاقات المراد جلب البيانات إليها
                SH.Range("C6:F99,H6:I99").ClearContents
'حلقة تكرارية لكل أوراق العمل في المصنف المسمى حسابات العملاء
                    For Each WS In WBK.Sheets
'سطر لاستثناء ورقة العمل المسماة الفهرس الرئيسي من الحلقة التكرارية
                        If WS.Name <> "الفهرس الرئيسى" Then
'بدء التعامل مع كل ورقة عمل على حدا
                            With WS
'إذا كانت أول خلية تحتوي على التواريخ فارغة يتم الانتقال لورقة العمل التالية
                                If IsEmpty(.Range("A6")) Then GoTo 1
'سطر لتفادي حدوث خطأ أي استمرار عمل الكود في حالة حدوث خطأ
                                On Error Resume Next
'حلقة تكرارية لنطاق التواريخ
                                For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
'إذا كانت الخلية التي تحتوي على التاريخ ، الشهر بها يساوي رقم الشهر في ورقة العمل في المصنف الحالي
'وكذلك السنة الموجودة في التاريخ تساوي سنة 2015 يتم تنفيذ الأسطر التالية
                                    If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then
'يتم جلب التاريخ ووضعه في العمود الثامن في أوراق العمل في المصنف الحالي
                                        SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value
'يتم جلب اسم العميل ووضعه في العمود الثالث في أوراق العمل في المصنف الحالي
                                        SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value
'يتم جلب قيمة القسط ووضعها في العمود الخامس في أوراق العمل في المصنف الحالي
                                        SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2)
'يتم جلب قيمة الكوبري ووضعها في العمود السادس في أوراق العمل في المصنف الحالي
                                        SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3)
'يتم جلب رقم التليفون ووضعه في العمود التاسع في أوراق العمل في المصنف الحالي
                                        SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value
'انتهاء أسطر الشرط
                                    End If
'الانتقال للخلية التالية التي تحوي تاريخ
                                Next Cell
'انتهاء التعامل مع ورقة العمل من المصنف المسمى حسابات العملاء استعداداً للتعامل مع ورقة عمل جديدة
1                             End With
                        End If
'الانتقال لورقة عمل جديدة في المنصف المسمى حسابات العملاء
                    Next WS
            End If
'الانتقال لورقة عمل جديدة في المصنف الحالي
        Next SH
'إغلاق المصنف المسمى حسابات العملاء بدون حفظ التغييرات
        WBK.Close SaveChanges:=False
'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

[سـامي 169]

الأخ الكريم محبوب

أعتذر عن التأخر في الرد عليك ، فقد كنت منشغلاً ..

إليك الشرح عله يفيدك إن شاء الله

Sub YasserKhalil()
'تعريف المتغيرات
    Dim WBK As Workbook
    Dim SH As Worksheet, WS As Worksheet, Cell As Range
'إلغاء خاصية اهتزاز الشاشة
    Application.ScreenUpdating = False
'إلغاء خاصية رسائل التنبيه
    Application.DisplayAlerts = False
'سطر لفتح المصنف المسمى حسابات العملاء لجلب البيانات منه
        Set WBK = Workbooks.Open(ThisWorkbook.Path & "\حسابات العملاء.xlsx")
'حلقة تكرارية لكل أوراق العمل في المصنف الحالي الذي يحوي الكود
        For Each SH In ThisWorkbook.Sheets
'سطر لاستثناء ورقة العمل المسماة الفهرس من الحلقة التكرارية
            If SH.Name <> "الفهرس" Then
'مسح محتويات النطاقات المراد جلب البيانات إليها
                SH.Range("C6:F99,H6:I99").ClearContents
'حلقة تكرارية لكل أوراق العمل في المصنف المسمى حسابات العملاء
                    For Each WS In WBK.Sheets
'سطر لاستثناء ورقة العمل المسماة الفهرس الرئيسي من الحلقة التكرارية
                        If WS.Name <> "الفهرس الرئيسى" Then
'بدء التعامل مع كل ورقة عمل على حدا
                            With WS
'إذا كانت أول خلية تحتوي على التواريخ فارغة يتم الانتقال لورقة العمل التالية
                                If IsEmpty(.Range("A6")) Then GoTo 1
'سطر لتفادي حدوث خطأ أي استمرار عمل الكود في حالة حدوث خطأ
                                On Error Resume Next
'حلقة تكرارية لنطاق التواريخ
                                For Each Cell In .Range("A6:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
'إذا كانت الخلية التي تحتوي على التاريخ ، الشهر بها يساوي رقم الشهر في ورقة العمل في المصنف الحالي
'وكذلك السنة الموجودة في التاريخ تساوي سنة 2015 يتم تنفيذ الأسطر التالية
                                    If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then
'يتم جلب التاريخ ووضعه في العمود الثامن في أوراق العمل في المصنف الحالي
                                        SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value
'يتم جلب اسم العميل ووضعه في العمود الثالث في أوراق العمل في المصنف الحالي
                                        SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value
'يتم جلب قيمة القسط ووضعها في العمود الخامس في أوراق العمل في المصنف الحالي
                                        SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2)
'يتم جلب قيمة الكوبري ووضعها في العمود السادس في أوراق العمل في المصنف الحالي
                                        SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3)
'يتم جلب رقم التليفون ووضعه في العمود التاسع في أوراق العمل في المصنف الحالي
                                        SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value
'انتهاء أسطر الشرط
                                    End If
'الانتقال للخلية التالية التي تحوي تاريخ
                                Next Cell
'انتهاء التعامل مع ورقة العمل من المصنف المسمى حسابات العملاء استعداداً للتعامل مع ورقة عمل جديدة
1                             End With
                        End If
'الانتقال لورقة عمل جديدة في المنصف المسمى حسابات العملاء
                    Next WS
            End If
'الانتقال لورقة عمل جديدة في المصنف الحالي
        Next SH
'إغلاق المصنف المسمى حسابات العملاء بدون حفظ التغييرات
        WBK.Close SaveChanges:=False
'إعادة تفعيل خاصية رسائل التنبيه
    Application.DisplayAlerts = True
'إعادة تفعيل خاصية اهتزاز الشاشة
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

افضل  مشاركة للاستاذ ياسر

لو كل الاكواد كده الله يبارك لكم

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

الأخ الفاضل محبوب

الحمد لله أن تم المطلوب على خير ، وعذراً إن كنت قد تأخرت عليك

 

يرجى تحديد أفضل إجابة

ستجد أسفل كل المشاركات كلمة "تحديد كأفضل إجابة" يمكنك اختيار المشاركة التي بها حل لمشكلتك وتحديدها

تقبل تحياتي

[mahbob]

أستاذى الفاضل ياسر خليل

بعد التحية والسلام

أتقبل بخالص الشكر الشديد لما قدمته لى من مساعدات

داعياً لك الله بدوام الصحه والعافيه وزياده وبركة فى العلم

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

فقد فهمت محتوياته بالدليل العملى للكود مع مشاهدة مواضيعك لكيفيه عمل الأكواد والتعامل معها 

ولكن كنت اريد توضيح كيفيه عمل هذا الكود

سأوضح لحضرتك قصدى فى هذا المثال

SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value

فى هذا الأمر sh ماذا تعنى

range وهى النطاق

calls وتعنى الخلايا التى بها البيانات

row + 1 على ما اعتقد انها اقل قمية زائد عمود

value تعنى القيمة ولا ايه معناها

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

 

وايضا لو حضرتك فتحت الملفات المرفقه سابقاً اللى هى الأقساط الشهرية وحسابات العملاء

وضغط أمر الترحيل سوف تجد انها ترحل بطريقه غير صحيحه

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

SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value

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

SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value

وايضا فى هذا  الأمر الذى يجلب قيمة القسط ووضعه فى العمود الخامس ،  يتم فيه ترحيل الجملة النهائية للأقساط لعميل معين

SH.Range("E" & SH.Cells(99, 5).End(xlUp).Row + 1) = Cell.Offset(, 2)

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

SH.Range("F" & SH.Cells(99, 6).End(xlUp).Row + 1) = Cell.Offset(, 3)

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

SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value

 

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

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

 

ولكى منى جزيل الشكر والتقدير ووسام شرف لى اننى اتعلم من سيادتك

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

الأخ الكريم محبوب

من الأفضل أن نناقش جزئية جزئية عشان بتوه في الكلام الكتير

مثال

SH.Range("H" & SH.Cells(99, 8).End(xlUp).Row + 1) = Cell.Value

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

لأننا بنعمل حلقة تكرارية لكل أوراق العمل .. بمعني مش منطقي إننا هنتعامل مع كل أوراق العمل كل ورقة عمل باسمها .. فبنرمز لأي ورقة بالمتغير ده وطبعا بما إنه متغير فبعد كل حلقة تكرارية ما تنتهي اسم ورقة العمل بيتغير لاسم ورقة عمل جديدة (تصدق أنا نفسي تهت)

 

Cells معناها خلايا بس استخدامها هنا عشان أعرف آخر صف فيه بيانات في العمود رقم 8

يعني مثلا

Cells(99, 8)

معناها الخلية في العمود رقم 8 والصف رقم 99

End(xlUp)

معناها اطلع لفوق .بالظبط زي ما بنضغط Ctrl + سهم لفوق عشان يطلعنا لآخر خلية بها بيانات في نفس العمود (اللي هو في المثال رقم 8)

Row 

عشان نعرف رقم الصف لآخر خلية فيها بيانات

 

زائد 1 عشان ننتقل لأول خلية فارغة في العمود رقم 8 عشان نبدأ ندرج فيه بيانات ...

 

يعني خلاصة الكلام الجزء ده كله

SH.Cells(99, 8).End(xlUp).Row + 1

معناه رقم صف أول خلية فارغة ....................!

يعني مثلا لو كان ناتج الجزء ده رقم 7 ..الصف السابع مثلا فيه أول خلية فارغة في هذا العمود

يبقا ممكن نختصر السطر

SH.Range("H7"(

ولما نوصل للخلية نخليها تساوي

Cell.value

الموضوع محتاج وقت عشان تقدر تدرسه كويس

ربنا يوفقك

[mahbob]

أستاذى الفاضل ياسر خليل

انا اعجز عن الشكر لحضرتك لكل ما تقدمه لى من مساعدات وتوجيهات

بارك الله لك فى جميع احوالك

طيب استاذى الفاضل لو انا غيرت أوامر الكود كالآتى هل سيحدث مشاكل

يعنى لو حددت لكل أمر نطاق معين مثل هذان الأمران هل هناك مشكلة

                                               
                                        SH.Range("C" & SH.Cells(99, 3).End(xlUp).Row + 1) = .Range("C2").Value
                                            
                                         SH.Range("I" & SH.Cells(99, 9).End(xlUp).Row + 1) = .Range("M8").Value   

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

أخي الكريم محبوب

مفيش أي مشكلة إنت جرب براحتك وشوف النتائج مظبوطة أو لا

طالما إن النطاق اللي هتاخد منه القيمة ثابت مفيش مشكلة على الإطلاق أما لو كان النطاق بيختلف يبقا لازم يكون فيه متغير في الكود عشان يتغير بتغير النطاق