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

konafa4000 · أغسطس 18, 2010

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

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

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

تحية طيبة ،

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

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

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

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

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

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

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

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

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

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

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

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

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

اخوكم Konafa4000

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

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

**طارق محمود** · أغسطس 19, 2010

السلام عليكم

أخي الكريم

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

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

كود واحد فقط موجود في الملف 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

ولدطيبة · أغسطس 19, 2010

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

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

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

konafa4000 · أغسطس 19, 2010

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

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

ليعطى 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

**طارق محمود** · أغسطس 20, 2010

السلام عليكم

بفرض ان الملف 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 · أغسطس 20, 2010

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

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

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

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

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

اخيرا

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

Konafa4000

**عبدالله باقشير** · أغسطس 20, 2010

السلام عليكم

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

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

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

خبور خير

konafa4000 · أغسطس 20, 2010

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

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

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

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

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

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

Konafa4000

konafa4000 · أغسطس 20, 2010

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

مع العلم بان

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

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

Salary.rar

**عبدالله باقشير** · أغسطس 20, 2010

السلام عليكم

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

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

خبور خير

**محمدي عبد السميع** · أغسطس 21, 2010

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

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

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

konafa4000 · أغسطس 21, 2010

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

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

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

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

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

اخيكم konafa4000

**عبدالله باقشير** · أغسطس 21, 2010

السلام عليكم

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

نعم صدقت

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

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

mhrrd · أغسطس 21, 2010

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

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

**عبدالله باقشير** · أغسطس 21, 2010

السلام عليكم

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

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 · أغسطس 21, 2010

الف شكر

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

konafa4000 · أغسطس 21, 2010

اخى خبور

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

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

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

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

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

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

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

اخيك Konafa4000

**عبدالله باقشير** · أغسطس 21, 2010

السلام عليكم

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

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

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

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

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

konafa4000 · أغسطس 22, 2010

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

ان خبرتى محدودة جدا فى مجال اكواد 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

**عبدالله باقشير** · أغسطس 22, 2010

السلام عليكم

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 · أغسطس 22, 2010

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

جزاك الله خير

سطر
 .Copy (wo.Worksheets(sn).Cells(k, "A"))
يوجد النسخ لكن اين عملية اللصق (انا اعلم ان K هو المجال الذى سيتم النسخ اليه)

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

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

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

konafa 4000

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

**عبدالله باقشير** · أغسطس 22, 2010

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

جزاك الله خير
سطر
 .Copy (wo.Worksheets(sn).Cells(k, "A"))
يوجد النسخ لكن اين عملية اللصق (انا اعلم ان K هو المجال الذى سيتم النسخ اليه)
اعتقدان ما بين الاقواس بعد كلمة Copy يمثل المدى او المجال الذي يلصق اليه وتنفذ عليه مباشرتا عملية اللصق

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

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

konafa 4000

نعم

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

تعقيب:

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

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

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

خبور خير

konafa4000 · أغسطس 22, 2010

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

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

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

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

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

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

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

konafa4000

Salary.rar

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

**عبدالله باقشير** · أغسطس 22, 2010

السلام عليكم

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

بارك الله فيك

konafa4000 · أغسطس 23, 2010

شكرا

تسجيل الدخول

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

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

konafa4000

طارق محمود

ولدطيبة

konafa4000

طارق محمود

konafa4000

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

konafa4000

konafa4000

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

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

konafa4000

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

mhrrd

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

mhrrd

konafa4000

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

konafa4000

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

konafa4000

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

konafa4000

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

konafa4000

Join the conversation

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

تصفح الموقع

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

Support

Important Information