ترحيل بيانات مجموعة ملفات الى ملف مجمع واحد

[konafa4000]

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

اخوانى اعضاء المنتدى

(رواده ، علماؤه ، المبتدئين ، ..... الخ)

تحية طيبة ،

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

لدى سؤال هنا ولقد حاولت البحث عن اجابته ولم أفلح ، واتمنى أن اجد اجابته هنا ؟

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

لدى مجموعه من التقارير R001 , R002 , R003 ..... الخ

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

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

والمطلوب كودموجود ضمن الملف Report001 للترحيل من التقرير R001 بيناته كاملة دون صف الاجمالى الى الملف Sal المجمع مع اعطاء العمود يخص تقرير اسم التقرير R001

وبالمثل كودموجود Report002 للترحيل من التقرير R002 الى الملف SAL بنفس الطريقة

وبالمثل كودموجودٌ Report003 للترحيل من التقرير R003 الى الملف Sal بنفس الطريقة

مرفق طيه الملفات

مع العلم بان الملف Sal بالشيت 1 موجود المطلوب الوصول اليها واريد التطبيق على شيت2

(ويسلام لو كان شرح للكود يكون فى الشيت 3 ، تبقى كنافة خالص)

شكر مقدم لجميع الزائرين لهذا الموضوع ومشاركيه،،،

اخوكم Konafa4000

ترحيل لملف اخر.rar

تم تعديل أغسطس 18, 2010 بواسطه konafa4000

[طارق محمود]

السلام عليكم

أخي الكريم

من حظك أنني عملت موضوع مماثل لصديق منذ وقت قريب

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

كود واحد فقط موجود في الملف Sal.xls

كل ماعليك هو فقط أن تنسخ الكود إلي ملفك

أو تنسخ الملف المرفق كله وتضعه مكان ملفك القديم (في نفس المجلد الذي به باقي الملفات)

ثم إفتحه وإضغط الزر الأصفر لتشغيل الماكرو

سيسألك عن عدد التقارير

ثم سيبدأ فتحها واحدا واحدا

يأخذ البيانات منه وينسخها في الملف Sal.xls

ثم يغلقه ويفتح التالي

الكود

Sub collect_data()

'

 rep_N = InputBox("Number of Reports from 001 to ?")


	For i = 1 To rep_N


	a = "Report" & Format(i, "00#") & ".xls"


	Workbooks.Open Filename:=a

	Sheets(1).Select

	sign = [c1000].End(xlUp).Value

	Range([a3], [a3].End(xlToRight).End(xlDown)).Select

	rr = Selection.Rows.Count

	Selection.Copy


	Workbooks("Sal.xls").Activate

	Sheets(2).Select

 	[A10000].End(xlUp).Offset(2, 0).Select

 	ActiveSheet.Paste

 	ActiveCell.Select

 	For j = 1 To rr

 	Selection.Offset(j - 1, 3) = sign

 	Next j

	Workbooks(a).Close


	Next i


End Sub

تفضل الملف ايضا

Sal.rar

[ولدطيبة]

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

ماشاء الله استاذ طارق ابداع × ابداع

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

[konafa4000]

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

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

ليعطى inputbox يحدد به التقرير الاول الذى يتم الترحيل ابتداء منه ثم يستكمل الكود بـ InputBox يحدد به التقرير الاخير وينفذ الكود

واصبح الكود

Sub collect_data()

'

 rep_f = InputBox("number of reports From ? ")

 rep_N = InputBox("Number of Reports  to ?")


    For i = rep_f To rep_N


    a = "Report" & Format(i, "00#") & ".xls"


    Workbooks.Open Filename:=a

    Sheets(1).Select

    sign = [c1000].End(xlUp).Value

    Range([a3], [a3].End(xlToRight).End(xlDown)).Select

    rr = Selection.Rows.Count

    Selection.Copy


    Workbooks("Sal.xls").Activate

    Sheets(2).Select

        [A10000].End(xlUp).Offset(2, 0).Select

        ActiveSheet.Paste

        ActiveCell.Select

        For j = 1 To rr

            Selection.Offset(j - 1, 3) = sign

        Next j

    Workbooks(a).Close


    Next i


End Sub

واصبح الملف كما هو مرفق Sal.xls

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

وهنا لى سؤال هذا كله يجب معه ان يكون الملف Sal مع باقى التقارير فى نفس المجلد

ولكن ماذا اذا كان كل تقرير موجود داخل فولدر يحمل اسمه R001,R002,R003 وهذه الفولدارات موجوده داخل فولدر رئيسى به الملف Sal ايضا

كما فى الملف المرفق باسم Salary ( لقد حاولت ان اكتب المسار امام المتغير A ولكن كان هناك دائما خطأ)

ومرة اخرى شكرا جزيلا ،،

ولك منى تحية انت واعضاء هذا المنتدى ،،،،

اخوك Konafa4000

Sal.rar

Salary.rar

تم تعديل أغسطس 19, 2010 بواسطه konafa4000

[طارق محمود]

السلام عليكم

بفرض ان الملف Sal

موجود في المجلد SS داخل المجلدFolder1 علي الدرايف D

وباقي الملفات موجودة كل منها في مجلد R00i داخل المجلدFolder1 أيضا علي الدرايف D

حيث 00i هو رقم التقرير في نفس الوقت

فقط إستبدل السطر

a = "Report" & Format(i, "00#") & ".xls"

بالسطر

a = "D:\Folder1\SS\R" & Format(i, "00#") & "\Report" & Format(i, "00#") & ".xls"

 

تم تعديل أغسطس 20, 2010 بواسطه TareQ M

[konafa4000]

السلام عليكم ،،،

مرة اخرى اشكرك اخى طارق لاهتمامك

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

وبالفعل يفتح التقرير الاول ويرحله ولكن المشكلة تكمن فى انه لايستطيع اغلاق التقرير الاول ثم الانتقال للتقرير التالى لترحيله ويتوقف الكود ويصبح الخطأ عند السطر Workbooks(a).Close قبل الانتقال للـ next i

ولكن اذا حذفت السطر Workbooks(a).Close ينفذ الكود كاملا ولكن التقارير كلها تظل مفتوحة مما يسبب حملا على زائد على الذاكرة

اخيرا

شكرا على سعه صدرك

Konafa4000

[عبدالله باقشير]

السلام عليكم

اذاكانت كل الملفات في نفس الفولدر مع الملف SAL

غير السطر 5 من الكود بهذا

Workbooks.Open Filename:=ActiveWorkbook.Path & "\" & a

خبور خير

[konafa4000]

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

اخ خبور خير شكرا على مشاركتك

الكود يعمل بشكل تام اذا كانت كل ملفات التقرير مع ملف Sal المجمع داخل فولدر واحد ٍ

ولكن ملفات التقارير موجودكل تقرير منهاداخل فولدر خاص به R001 , R002 , R003 (فكل فولدر يعبر عن تقرير لمجموعه بيانات خاصه به داخل هذا الفولدر) وكل هذه الفولدرات موجودة مع ملف الSal داخل مجلد رئيسى Salary وقد ارفقت الحالة بالضبط كماهى

والمشكلة تكمن فى ان تنفيذ الكود يفتح التقرير الاول Report001 من داخل الفولدر الخاص به R001 وينقل البيانات الى ملف Sal ولكنه عندما يصل الى السطر Workbooks(a).Close يفشل فى اغلاق التقرير Report001 ويتوقف العمل عند هذا السطر

اما اذا حذفت هذا السطر Workbooks(a).Close فان الكود يعمل بسلاسة ويفتح كل تقرير من الفولدر الخاص به وينقل بيناته ولكن فى المقابل تظل التقارير مفتوحة فان كان هناك مثلا 50 فولدر بـ 50 تقرير فان هذا يعنى فتح كل هذه الملفات وتركها مفتوحة مما يمثل حملا على الذاكرة Ram

Konafa4000

[konafa4000]

الحالة كما هى بالمرفقات

مع العلم بان

 "C:\Documents and Settings\mido\Desktop\Salary\R" & Format(i, "00#") & "\Report" & Format(i, "00#") & ".xls"

وهو المسار الذى يوجد به الفولدارات R001,R002,R003 التى بها التقارير Report001,Report002,Report003

Salary.rar

[عبدالله باقشير]

السلام عليكم

تمت بعض التعديلات في الكود :

Sub collect_data()

Dim a, x, rep_N

 rep_N = InputBox("Number of Reports from 001 to ?")

    Application.ScreenUpdating = False

    For I = 1 To rep_N

    x = "Report" & Format(I, "00#") & ".xls"

    a = ActiveWorkbook.Path & "\" & "R00" & I & "\" & x


    Workbooks.Open Filename:=a

    Sheets(1).Select

    sign = [c1000].End(xlUp).Value

    Range([a3], [a3].End(xlToRight).End(xlDown)).Select

    rr = Selection.Rows.Count

    Selection.Copy



    Workbooks("Sal.xls").Activate

    Sheets(2).Select

        [A10000].End(xlUp).Offset(2, 0).Select

        ActiveSheet.Paste

        ActiveCell.Select

        For j = 1 To rr

            Selection.Offset(j - 1, 3) = sign

        Next j

        Application.CutCopyMode = False

        Windows(x).Close False

    Next I

    Application.ScreenUpdating = True

End Sub

خبور خير

[محمدي عبد السميع]

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

العالم العلامة خبور خير

جزيت خيرا من الله العلي القدير

[konafa4000]

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

اخى خبور خير ، هذا هو بالضبط ما أحتاجه ،

شكرا جزيلا لك وجزاك الله خير واعانك الله على فعل الخير

وفى نفس هذا السياق لا انسى شكر اخى طارق - بارك الله له- كاتب الكود الاصلى وتعاونه الدائم ومجهوده الكبيرمعى فى هذا الموضوع

تحياتى لكل أعضاء المنتدى

اخيكم konafa4000

[عبدالله باقشير]

السلام عليكم

وفى نفس هذا السياق لا انسى شكر اخى طارق - بارك الله له- كاتب الكود الاصلى وتعاونه الدائم ومجهوده الكبيرمعى فى هذا الموضوع

نعم صدقت

الشكر واصل للاخ الحبيب طارق

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

[mhrrd]

التعديلات الاخيرة

ممكن تضغوها في ملف

[عبدالله باقشير]

السلام عليكم

تم اضافة بعض التعديلات

Option Explicit



Sub collect_data()

On Error Resume Next

Dim rep_N

Dim wo As Workbook

Dim sn As String, a As String, z As String, x As String, sign As String

Dim i As Integer

Dim rr As Long, j As Long, k As Long

Set wo = ActiveWorkbook

sn = ActiveSheet.Name

rep_N = InputBox("Number of Reports from 001 to ?", wo.Name)

Application.ScreenUpdating = False

For i = 1 To rep_N

    k = wo.Worksheets(sn).Range("A1000").End(xlUp).Row + 2

    z = ActiveWorkbook.Path & "\" & "R00" & i & "\"

    x = "Report" & Format(i, "00#") & ".xls"

    a = z & x

    If Workbook_Exists(z, x) Then

        Workbooks.Open Filename:=a

        Sheets(1).Select

        sign = [c1000].End(xlUp).Value

        With Range([a3], [a3].End(xlToRight).End(xlDown))

            rr = .Rows.Count

            .Copy (wo.Worksheets(sn).Cells(k, "A"))

        End With

        wo.Worksheets(sn).Cells(k, "D").Resize(rr, 1).Value = sign

        Workbooks(x).Close False

    End If

Next i

Application.ScreenUpdating = True

Set wo = Nothing

On Error GoTo 0

End Sub

--------------------------------------------------------------------------

Option Explicit


Function Workbook_Exists(FilePath As String, Filename As String) As Boolean

  With Application.FileSearch

        .LookIn = FilePath

        .Filename = Filename

        Workbook_Exists = .Execute > 0

    End With

End Function

ممكن تستدعي البيانات من اي ملف موجود فيه الكود ActiveWorkbook

واي ورقة في الملف ActiveSheet

تفضل المرفق

Salary.rar

[mhrrd]

الف شكر

ثناؤنا لك هو الدعاء لك

[konafa4000]

اخى خبور

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

بالفعل لقد اذهلتنى بهذه التعديلات ،

فالكود يؤدى الوظيفة بفاعلية من اى ملف يوضع به الكود

لقد اذهلتنى بانشاء الدالة Workbook_Exists بالمديول 2 لاستخدامها للتحقق من مسار الملفات التقارير فى الكود الاصلى بمديول 1

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

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

لذا سأكون سعيدا وممنوناجدا اذا وضعت لى شرح مبسطا للكود بالمديول 1 وانشاء الدالة بالمديول 2

اخيك Konafa4000

[عبدالله باقشير]

السلام عليكم

لقد اذهلتنى بانشاء الدالة Workbook_Exists بالمديول 2 لاستخدامها للتحقق من مسار الملفات التقارير فى الكود الاصلى بمديول 1

الدالة هذه وجدتها في احدى الملفات جاهزة

وقد استخدمتها من سابق في ملفاتي الخاصة

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

ما هي السطور التي لم تفهمها؟

[konafa4000]

السلام عليكم اخى خبور ،،

ان خبرتى محدودة جدا فى مجال اكواد VBA ، ولكننى احاول ان اتعلم هذه اللغة وخباياها

سطر مثل

Option Explicit

اجده فى المديول 1 ، والمديول 2 وانا لا اعرف مافائدته او ماذا يعنى عند انشاء الدالة Workbook_Exists لم افهم السطر

 Workbook_Exists = .Execute > 0

فى المديول 1

On Error Resume Next

عموما جمل on error مش قادر افهمها سطر

  .Copy (wo.Worksheets(sn).Cells(k, "A"))

يوجد النسخ لكن اين عملية اللصق (انا اعلم ان K هو المجال الذى سيتم النسخ اليه) الاسطر

Set wo = Nothing

On Error GoTo 0

ما معناها و فائدتها

شكر على سعة صدرك

konafa4000

تم تعديل أغسطس 22, 2010 بواسطه konafa4000

[عبدالله باقشير]

السلام عليكم

Option Explicit

تم شرحها في المشاركة رقم 26 في الرابط التالي: اعداد كشوفات مدرسية باختيار روؤس الاعمدة عن طريق فورم ------------------------------------------

Workbook_Exists = .Execute > 0

Execute غرض من اغراض Application.FileSearch اذا كانت قيمته اكبر من الصفر ياخذ القيمة True معنى ان الرابط موجود ------------------------------------------ On Error Resume Next يجعل الكود يستمر في التنفيذ في حالة وجود اي خطا On Error GoTo 0 تسمح بمقاظعة الاخطاء في حالة تنفيذ الاجرائية -------------------------------------------

Set wo = Nothing

الغاء الربط بين المتحول wo والغرض Workbook

خبور خير

[konafa4000]

اخى خبور شكرا لك

جزاك الله خير

سطر

 .Copy (wo.Worksheets(sn).Cells(k, "A"))

يوجد النسخ لكن اين عملية اللصق (انا اعلم ان K هو المجال الذى سيتم النسخ اليه)

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

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

هل أنا محق فى ذلك ؟

konafa 4000

تم تعديل أغسطس 22, 2010 بواسطه konafa4000

[عبدالله باقشير]

اخى خبور شكرا لك

جزاك الله خير

سطر

 .Copy (wo.Worksheets(sn).Cells(k, "A"))

يوجد النسخ لكن اين عملية اللصق (انا اعلم ان K هو المجال الذى سيتم النسخ اليه)

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

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

هل أنا محق فى ذلك ؟

konafa 4000

نعم

----------------------------------------------

تعقيب:

نحن نحتاج الى تعيين خلية واحدة فقط عند اللصق

و يشمل اللصق بهذه الطريقة

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

خبور خير

[konafa4000]

اخى خبور الشكر متواصل لك ، ولكل اعضاء المنتدى

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

المشكلة ان الكود لا يرحل الا لغاية التقرير 9 اما التقارير من 10 الى ما فوق لا يرحلها

وقد حددت المشكلة بالمتغير z الذى يحدد مسار الفولدر الذى به التقرير (حيث i سياخذ الخانه الاخيرة بعد R00 باسم الفولدر)

وقمت بتعديله ليصبح بنفس اسلوب المتغير x (وبالتالى i سيأخذ 3 خانات يمينR باسم الفولدر) وبالتالى سيمكن الترحيل حتى التقرير 999 ان وجد

وقمت بالتعديل على الملف Kh_sal وتركته كما هو فى Sal وارفقت تقارير اضافية 10 ، 11 ، 211

وقد نجحت فى ذلك ولكن احتاجك فى مراجعتها فربما اكون مخطئى فى شيئ لن ادركه الا فى حينه

konafa4000

Salary.rar

تم تعديل أغسطس 22, 2010 بواسطه konafa4000

[عبدالله باقشير]

السلام عليكم

التعديل تمام التمام

بارك الله فيك

[konafa4000]

شكرا