شرح كود

mahbob · مايو 3, 2015

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

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 · مايو 4, 2015

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

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

ياسر خليل أبو البراء · مايو 5, 2015

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

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

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

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

الصبر فقط

mahbob · مايو 5, 2015

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

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

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

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

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

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

ياسر خليل أبو البراء · مايو 5, 2015

الأخ الفاضل

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

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

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

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

mahbob · مايو 5, 2015

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

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

ملفات.rar

mahbob · مايو 7, 2015

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

ياسر خليل أبو البراء · مايو 8, 2015

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

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

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

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

تقبل تحياتي

mahbob · مايو 8, 2015

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

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

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

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

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

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

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

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

ياسر خليل أبو البراء · مايو 8, 2015

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

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

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

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 · مايو 9, 2015

في 8‏/5‏/2015 at 19:19, ياسر خليل أبو البراء said:

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

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

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

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

تقبل تحياتي

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

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

ياسر خليل أبو البراء · مايو 9, 2015

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

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

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

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

تقبل تحياتي

mahbob · مايو 9, 2015

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

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

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

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

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

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

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

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

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

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

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

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

ياسر خليل أبو البراء · مايو 9, 2015

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

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

مثال

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 · مايو 10, 2015

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

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

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

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

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

                                        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

ياسر خليل أبو البراء · مايو 11, 2015

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

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

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

تسجيل الدخول

شرح كود

الردود الموصى بها

mahbob

mahbob

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

mahbob

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

mahbob

mahbob

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

mahbob

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

سـامي 169

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

mahbob

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

mahbob

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

Join the conversation

محتوي مشابه

شرح بالفيديو كل ما يتعلق بــ الأصول الثابتة

[درس خفيف] شاشة انتظر من فضلك !! | سلسلة مهارات في أكسس | 06 |

شرح فيديو لدالة VLOOKUP بالأمثلة العملية

شرح دالة fv

شرح كيف أستعمل الماوس مع الاكسيل ؟؟؟

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

تصفح الموقع

تصفح جديد الموقع

Support

Important Information