طلب ترحيل الأقساط الشهرية لكل عميل

[mahbob]

السلام عليكم إخوانى الأعزاء

 

سبق لى طرح هذا الموضوع من قبل ولم يتم الإستجابة له

فرجاءاً من حضراتكم أن تساعدونى ولو بفكره

 

وعذراً لكم لكثرة سؤالى

 

يوجد بالمرفقات ملف يحتوى على حسابات العملاء ، لكل عميل أقـساط معـينه شهرياً

وأريد ترحيل هـذه الأقـساط لكـل عـميل فى ملـف الأقـساط الشهرية 2015

 

بمعنى أن هناك أكثر من عـميل لهم أقـساط فى شهر يناير 2015 مثلاً أريد ترحيل المبلغ المستحق لكـل

عميل له قـسط  فى هذا الشهر

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

 

وهناك مثال لتوضيح ما أطـلبه

 

ملف.rar

 

 

[ابو علي و سدرة]

علشان تضمن ان الترحيل صحيح لابد من وجود الملفين معا فى مسار واحد ( فولدر واحد ) ولابد من فتح الملفين معا وبرضه مش هاتبقى متأكد بنسبة 100 % من صحة الترحيل لانك لو فى مرة نسيت تفتح الفايل التانى ( حسابات العملاء ) مش هايرحل فالاضمن انك تعملهم هم الاتنين فى ملف واحد

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

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

تعبت والله ..بقالي ساعتين عشان أعمل الكود الملعبك ده

بس الحمد لله بفضل الله تم المطلوب .. افتح ملف "الأقساط الشهرية 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 & "\حسابات العملاء 1.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) 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

Function MonthNumber(MonthName As Variant) As Variant
    Select Case MonthName
        Case "": MonthNumber = ""
        Case "يناير": MonthNumber = 1
        Case "فبراير": MonthNumber = 2
        Case "مارس": MonthNumber = 3
        Case "ابريل": MonthNumber = 4
        Case "مايو": MonthNumber = 5
        Case "يونيو": MonthNumber = 6
        Case "يوليو": MonthNumber = 7
        Case "اغسطس": MonthNumber = 8
        Case "سبتمبر": MonthNumber = 9
        Case "اكتوبر": MonthNumber = 10
        Case "نوفمبر": MonthNumber = 11
        Case "ديسمبر": MonthNumber = 12
    End Select
End Function

تقبل تحياتي

ولا تنسى أن تحدد المشاركة إذا أعجتك الإجابة كأفضل إجابة (ساعتين مني قصاد ثانيتين منك .. أظن كدا عدل والحمد لله)

 

Three Loops In Two Excel Files By YasserKhalil.rar

[صلاح الصغير]

ا / ياسر

 

و االله قليل عليك ان تحدد الاجابة كافض اجابة

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

ما بالك باللى عمله

روح يا شيخ ربنا يكرمك

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

جزاك الله خيراً أخي الحبيب صلاح على هذه الكلمات الرقيقة ..

روح ربنا يبارك فيك .. المهم تكون استفدت من الملف

 

الكود بيعتمد على جلب بيانات من ملف حسابات العملاء .. ففيه حلقة تكرارية لكل ورقة من أوراق العمل في المصنف " الأقساط الشهرية" اللي فيه الشهور المفروض تتوزع عليها البيانات .. وداخل كل حلقة بيتم التعامل مع المصنف التاني "حسابات العملاء" بيتم أيضا الحلقات التكرارية لكل أوراق العمل ، وداخل كل ورقة عمل بيتم عمل حلقة تكرارية للعمود الأول لاستخراج رقم الشهر .. ومن خلال رقم الشهر بنشوف هل رقم الشهر بيساوي أي رقم ونترجمه لمرادفه من أسماء الشهور .. يعني الرقم 1 معناه يناير وهكذا ..عشان يتم وضع كل بيان في ورقة العمل المناسبة في المصنف "الأقساط الشهرية" ..يعني الملف فيه حلقات جننتني ..عشان دي أول مرة أكتب فيها 3 حلقات في كود واحد ..أنا كان آخري حلقتين بس الحمد لله تم بحمد الله وتحقق المطلوب وتم جلب البيانات في كل ورقة عمل بما يتناسب مع التاريخ لكل بيان

تقبل تحيااتي

[mahbob]

علشان تضمن ان الترحيل صحيح لابد من وجود الملفين معا فى مسار واحد ( فولدر واحد ) ولابد من فتح الملفين معا وبرضه مش هاتبقى متأكد بنسبة 100 % من صحة الترحيل لانك لو فى مرة نسيت تفتح الفايل التانى ( حسابات العملاء ) مش هايرحل فالاضمن انك تعملهم هم الاتنين فى ملف واحد

شكراً جزيلاً أستاذى العزيز لنصيحتك الجميلة

وجزيل الشكر لإهتمامك بالموضوع

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

[mahbob]

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

تعبت والله ..بقالي ساعتين عشان أعمل الكود الملعبك ده

بس الحمد لله بفضل الله تم المطلوب .. افتح ملف "الأقساط الشهرية 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 & "\حسابات العملاء 1.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) 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

Function MonthNumber(MonthName As Variant) As Variant
    Select Case MonthName
        Case "": MonthNumber = ""
        Case "يناير": MonthNumber = 1
        Case "فبراير": MonthNumber = 2
        Case "مارس": MonthNumber = 3
        Case "ابريل": MonthNumber = 4
        Case "مايو": MonthNumber = 5
        Case "يونيو": MonthNumber = 6
        Case "يوليو": MonthNumber = 7
        Case "اغسطس": MonthNumber = 8
        Case "سبتمبر": MonthNumber = 9
        Case "اكتوبر": MonthNumber = 10
        Case "نوفمبر": MonthNumber = 11
        Case "ديسمبر": MonthNumber = 12
    End Select
End Function

تقبل تحياتي

ولا تنسى أن تحدد المشاركة إذا أعجتك الإجابة كأفضل إجابة (ساعتين مني قصاد ثانيتين منك .. أظن كدا عدل والحمد لله)

تحية وتقدير بدايةً

أسعدنى مرورك قبل مشاركتك

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

وفققك الله لكل ما يحبه ويرضاه

تقبل شكرى وتقديرى أستاذنا العزيز \  ياسر

:fff: :fff: :fff:

[mahbob]

أستاذى العزيز \ ياسر

بعد التحيه ...

أنا فتحت الملف وشاهدت مجهودك العظيم الذى فعلته من أجلى ومن أجل الجميع

لأنه موضوع يستحق المشاهده للإستفاده منه لجميع الأعضاء وليس أنا فقط

ولكن هناك بعض الملاحظات :

حضرتك بحثت أو رحلت بطريقه البحث عن الشهر فقط

لو حضرتك نظرت فى ملف الأقساط الشهرية هتلاقيه لسنه 2015 فقط

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

ما أريده إن أقساط الشهور لسنه 2015 فقط تترحل فى هذا الملف

لأنى سأنشئ ملفات آخرى خاصه لكل سنة على حدى

 

 

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

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

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

بداية أشكرك على كلماتك الرقيقة ودعائك الطيب

بالنسبة لطلبك الثاني فهو أبسط مما تتخيل ، وكان من الممكن لو دققت في الكود توصله

غير سطر الشرط فقط ..هنزود عليه شرط السنة وبس

If Month(Cell.Value) = MonthNumber(SH.Name) And Year(Cell.Value) = 2015 Then

شفت الدنيا سهلة إزاي

تقبل تحياتي

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

الأخ الغالي محبوب ...

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

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

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

Three Loops In Two Excel Files By YasserKhalil V2.rar

[mahbob]

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

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

بس انا بالنسبة للتعامل مع الاكواد لسه مبتدئ

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

 

 

أما بقى لرد الجميل مش يستاهل بس فردة كاوتش دا يستاهل فردتين كاوتش ههههههههههههه

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

دا انا غلبان

 

أنا لا أملك إلا أن أدعو لك بصلاح أحوالك

وجزاك الله كل الخير على ما تقدمه لخدمة الجميع

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

:fff: :fff: