اذهب الي المحتوي
أوفيسنا

هل يمكن ترحيل بيانات من عدة ملفات دون فتحها ؟


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

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

هل يمكن ترحيل بيانات من عدة ملفات دون فتحها ؟

وذلك دون اغفال عامل السرعة فى عمل الكود نفسه

وشكرا

رابط هذا التعليق
شارك

السلام عليكم

الرجاء التوضيح أكثرا لكي نستطيع مساعدتك

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

ولا يهم أن تكون الملفات في فولدر واحد

تم تعديل بواسطه tahar1983
رابط هذا التعليق
شارك

هذا هو ملف من ضمن عدة ملفات فى النطاق e:/excel files/daily plant report

والملفات باسم daily plant report 1/9/2011

وذلك إلى نهاية الشهر

والنطاق ِيت production!c85:c90

المشكلة هناك ملف فى مكتبة الموقع Data collector 3يقوم بذلك ولكن ينقصة شئ هو السرعة حيث

يقوم بفتح كل ملف يأخذ منه البيانات مما يؤدى إلى بطء العملية

http://www.officena.net/ib/index.php?app=downloads&showfile=109

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

وشكرا

سارفق ملف من ضمن الملفات التى اريد تجميع البيانات منها

Daily plant report 01-09-2011.rar

رابط هذا التعليق
شارك

السلام عليكم

الأخوة الكرام

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

و المثال المشار اليه يقوم بذلك بعد فتح الملفات

http://www.officena....ds&showfile=109

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

بالنسبة للاستيراد كبيانات فقط ، دون فتح الملف يمكن استخدام

ExecuteExcel4Macro

لاستدعاء دالة Get Cell الجاهزة و هي دالة قديمة نسبيا تعود لماكروهات اكسيل 4 و هي تستدعي خلية بخلية (واحدة واحدة) لذا يتم وضعها فى لوب عند الاستدعاء مع اضافة المسار الكامل للملف و ورقة العمل و الخلية عند كل استدعاء ، و لكن لا تستدعي التنسيق مع البيانات ، و هو ليس ما يريده صاحب الموضوع

http://msdn.microsof...fice.11%29.aspx

و عليها مثال هنا

http://www.exceltip...._Excel/473.html

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



Dim wb As Workbook

	Application.ScreenUpdating = False ' turn off the screen updating

	Set wb = Workbooks.Open("C:\Foldername\Filename.xls", True, True)

	' open the source workbook, read only

	With ThisWorkbook.Worksheets("TargetSheetName")

		' read data from the source workbook

		.Range("A10").Formula = wb.Worksheets("SourceSheetName").Range("A10").Formula

		.Range("A11").Formula = wb.Worksheets("SourceSheetName").Range("A20").Formula

		.Range("A12").Formula = wb.Worksheets("SourceSheetName").Range("A30").Formula

		.Range("A13").Formula = wb.Worksheets("SourceSheetName").Range("A40").Formula

	End With

	wb.Close False ' close the source workbook without saving any changes

	Set wb = Nothing ' free memory

	Application.ScreenUpdating = True ' turn on the screen updating

End Sub

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

الأخ leprince2007

بالمناسبة فكرة تنسيق الخلايا فى الملف المرفق كعينة للبيانات المطلوبة جميلة جدا (الحد الازرق المائل ) ، و لاول وهلة لم ادرك كيفية عملها ، و بعد ان فهمتها اعجبتني الفكرة جدا

و ارجو الاجابة على الاسئلة التالية:

1- هل هو هذا النطاق فقط ثابت دائما ؟ production!c85:c90

2- المجال الذي اشرت اليه ليس به تنسيقات كثيرة فربما لا تحتاج حقيقة لنسخ التنسيق اذا كان التنسيق هو تنسيق واحد بسيط للخلايا كلها فيمكنك عمله سريعا او تسجيله فى ماكرو و حفظه فى جهازك و تنفيذ الماكرو على البيانات ؟ ام الحال مغاير لذلك؟

3- جربت البرنامج مع ملفك (ستة نسخ منه) ، و لم يأخذ وقت ملحوظ، فى المتوسط كم عدد الملفات التي ترغب فى تجميع البيانات منها؟

4- ايضا ما مواصفات الجهاز الذى تستخدمه ؟ اذهب الي My computer و اضغط بالزر الايمن و اختار properties و اخبرني بالبروسيسور و الرام

5- هل الملفات على جهازك مباشرة ام على شبكة ( خادم مشترك) ؟

رابط هذا التعليق
شارك

بالمناسبة فكرة تنسيق الخلايا فى الملف المرفق كعينة للبيانات المطلوبة جميلة جدا (الحد الازرق المائل ) ، و لاول وهلة لم ادرك كيفية عملها ، و بعد ان فهمتها اعجبتني الفكرة جدا

نرجو ان يتم ايضاح طريقة عمل مثل هذا التنسيق الجميل للفائدة

رابط هذا التعليق
شارك

عن طريق اختيار زاوية محاذاة ميل الكتابة

Properties

alignment

orientation

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

رابط هذا التعليق
شارك

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

شكرا للأخوة على الرد والاهتمام

بالنسبة لأسئلة الاستاذ محمد طاهر:

1- النطاق ليس ثابتا ، فأنا اريد البرنامج أن يتعامل مع أى نطاق أعطيه له فى أى ملفات

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

3- عدد الملفات 30 ملف

4- مواصفات جهازى هى:

P4 2.4GH

700MB: Ram

5- الملفات على الجهاز نفسه

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

رابط هذا التعليق
شارك

السلام عليكم

ان مواصفات الجهاز عامل مهم جدا فى سرعة الاداء

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

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

و هذا لا يمنع طرق سبل اخري للتعديل و لكن فى كل الاحوال ستظل امكنيات و سرعة الجهاز عامل مؤثر بدرجات متفاوتة فى سرعة تشغيل التطبيق

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

بالنسبة لتسجيل ماكرو

اولا تحتاج لاختيار اظهار مجموعة ال developper اذا لم تكن تظهر لديك فى اوفيس 2010

و ذلك عن طريق النقر بالزر الايمن بجانب مجموعة الادوات العلوية

و اختيار تخصيص شريط الادوات

Customize the ribbon

او

file

options

Customize the ribbon

و اختيار اظهار مجموعة ال

developper

gallery_3_15_90864.png

و ستجد فيها امر

record new macro

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

ثم اختار بداية التسجيل

record macro

و اختار ان يكون تسجيله فى الملف نفسه

و قم مثل باضافة بعض التنسيقات كلون الخلفية و الاطار border و لون و حجم الفونت

ثم اختا ر Stop recording

و الان اختار تحرير edit لتري الكود

لتشغيل الكود

اختار اي خلايا اخري ، ثم اضغط

ALT+f8

او macros من الشريط

و اختار تشغيل الماكرو ، سيطبق عليها نفس التنسيق

و اذا كان الماكرو مستخدم باستمرار يمكنك تسجيله فى ال personal macro sheet

ليكون متاحا فى كل الملفات

او فتح الملف المسجل به الماكرو اثناء تشغيله

او نقل الماكرو للملف الذي تريد عن طريق التصدير او السحب و الافلات من محرر البيزيك ALT+F11

و الموقع به العديد من المواضيع التي تتناول تسجيل و نقل الماكرو بجرب البحث و التصفح لهذه المواضيع

رابط هذا التعليق
شارك

شكرا يا أستاذ محمد طاهر

أنا اريد تطبيق هذه المعادلة الجاهزة التى ذكرتها Getcell على الملفcollector Data

التى تقوم بنسخ القيم فقط لمجموعة ملفات مغلقة ، ولا حاجة الآن للتنسيق ، السرعة أهم من أى شئ بالنسبة لى.

وشكرا جزيلا

رابط هذا التعليق
شارك

السلام عليكم

الحقيقة أن تطبيق هذه الطريقة ممكن اذا استبعدنا التنسيق ، و اتوقع انه سيكون اسرع

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

رابط هذا التعليق
شارك

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

لقد ذكر الأخوة alidroos و tahar1983

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

الرجاء الاهتمام يا جماعة

رابط هذا التعليق
شارك

السلام عليكم

اخي و استاذنا محمد طاهر

بارك الله فيك و جزاك الجنة

واذن لي بالمشاركة واتمني ان اكون قد فهمت المطلوب

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

اخي leprince2007

قم بفك الملف المرفق بالكامل في اي مكان

افتح الملف الذي اسمه 2.xls

اضغط علي زر انقل البيانات

يوجد شرح بداخل الملف

و الكود المستحدم هو


Sheets("data").Range("A1:f1000") = ""

m = ThisWorkbook.Path & "\" & "1.xls"

Set wb = Workbooks.Open(m, True, True)

For Each cell In Sheets("sheet1").Range("A1:f1000")

If cell <> "" Then

n = cell.Address

If cell.HasFormula Then

m = cell.Formula

Windows("2.xls").Activate

Sheets("data").Range(n) = m

Else

m = cell.Value

Windows("2.xls").Activate

Sheets("data").Range(n) = m

End If

End If

Next

Windows("1.xls").Activate

Application.DisplayAlerts = False

ActiveWorkbook.Close

Application.DisplayAlerts = True

علما بان نقل البيانات يتم علي الخلايا اذا كان بها بيانات او معادلات

عموما هذا رابط للملف

نقل البيانات من ملف اخر.rar

  • Like 1
رابط هذا التعليق
شارك

ايضا بنفس الطريقة

يتم نقل البيانات من عدة ملفات الي الملف الذي اسمه 2.xls

اتبع ايضا نفس الخطوات السابقة

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

نقل البيانات من ملف اخر.rar

  • Like 1
رابط هذا التعليق
شارك

السلام عليكم

الاخ الفاضل leprince2007

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

يقوم بالنسخ والملف مغلق

ولاكن ؟؟؟؟؟؟؟؟؟؟؟

؟؟؟؟؟؟؟؟ لملف واحد فقط :blink:


Private Function GetValue(path, file, sheet, ref)

    Dim arg As String

    If Right(path, 1) <> "\" Then path = path & "\"

    If Dir(path & file) = "" Then

	    GetValue = "File Not Found"

	    Exit Function

    End If

    arg = "'" & path & "[" & file & "]" & sheet & "'!" & _

	  Range(ref).Range("A1").Address(, , xlR1C1)

    GetValue = ExecuteExcel4Macro(arg)

End Function

Sub TestGetValue2()

'====================================

    p = "C:\temp"

' المسار احد الاقراص فقط دون ملف الاكسل

'====================================

    f = "ALI2011.xls"

' إسم ملف الإكسل فقط

'====================================

    s = "ورقة1"

' إسم الورقة المراد نسخ احد البيانات منها

'====================================

    Application.ScreenUpdating = False

'====================================

    For r = 1 To 100

' هنا حلقة التكرار تعبر عن الصفوف من صف رقم واحد حتى صف رقم 100

'====================================

	    For c = 1 To 12

' هنا حلقة التكرار تعبر عن الاعمدة من عمود رقم 1 حتى عمود رقم 12

'====================================

' =======================

' المدى ككل من A1:L100

'========================

		    a = Cells(r, c).Address

		    Cells(r, c) = GetValue(p, f, s, a)

	    Next c

    Next r

    Application.ScreenUpdating = True

End Sub

هذا الكود سبق ان ذكرة الاستاذ القدير والمعلم الكبير محمد طاهر

تحياتي

  • Like 1
رابط هذا التعليق
شارك

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

شكرا للأخوة Adel Hanafy وAlidroos

أولا : يا أستاذ Adel Hanafy أرجو أن ترفع الملف على سيرفر المنتدى لكى أجربه

تأكد أولا من تثبيت برنامج flash player واستخدام متصفح يدعم ذلك مثل Firefox

ثانياًً : يا أستاذ Ali droos ألا توجد طريقة لجعل هذا الكود الذى وضعته يقوم بالترحيل من عدة ملفات فى فولدر.

وشكرا جزيلا لتعاونكم

رابط هذا التعليق
شارك

السلام عليكم

أخي عادل ، alidroos ، أشكركم على المداخلة ،

أخي عادل ، هذه الطريفة تعتمد على فتح الملف و غلقه ، و هو ما لا يريده السائل، نعم فى حالة الملفات الصغيرة لا تأخذ وقتا و قد لا نلحظ عملية فتح و غلق الملف لانها تتم سريعا لاسيما فى حالة الاجهزة الحديثة نوعا ما ، و لكن فى حالته الملف دسم جدا ، و يستغرق وقت فى الفتح لكل ملف على جهازه

لذا نحاول استمطار افكار بخصوص تطبيق ما يريد على كافة الملفات بالمجلد و بالخصائص المشار اليها هنا ، و حاليا لا اعرف سوي تطبيق الفكرة المشار اليها علاه باستخدام Get Value أو التعامل مع الموضوع من خلال ال ADO Connection و نقل السجلات لذا رغبت فى أن نتشارك فى التفكير قبل محاولة التنفيذ ، و أرجح الفكرة الاولي حيث لا تحتاج لاضافة مراجع للملفات فيصبح التطبيق أكثر عمومية .

عموما سأبدأ فى تجربتها و تعديل التطبيق بإذن الله باستخدام Get Value

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

رابط هذا التعليق
شارك

تم تنفيذ التعديل فى الملف الأصلي

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

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

رابط هذا التعليق
شارك

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information