احمد_محمود قام بنشر سبتمبر 28, 2014 مشاركة قام بنشر سبتمبر 28, 2014 (معدل) السلام عليكم لدي العديد من الملفات و احتاج الى تعديلها جميعها وفق هذه الخطوات 1- حذف الاعمدة D,E 2- خلايا العامود D = B - C مع الحفاظ على القيم دون المعادلة 3- ضرب العامود C ب 100000 4- حذف العامود B هل من طريقة لجعل جميع الملفات تتعدل بشكل ألي ؟ تم تعديل سبتمبر 28, 2014 بواسطه احمد_محمود رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر سبتمبر 29, 2014 مشاركة قام بنشر سبتمبر 29, 2014 السلام عليكم نعم أخي هناك طبعا طريقة بالأكواد تضع الملفات كلها (المطلوب تعديلها) في مجلد واحد تزيد عليهم ملف آخر به الكود تكون فكرة الكود أنه يفتح الملفات واحد بعد واحد ثم يجري عليه التعديلات ويحفظه ثم يغلقه ويفتح التالي إل نهاية الملفات سهلة إن شاء الله رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر سبتمبر 29, 2014 مشاركة قام بنشر سبتمبر 29, 2014 السلام عليكم أخي العزيز تفضل الملف المرفق به الكود المطلوب تضع الملفات كلها (المطلوب تعديلها) في مجلد واحد وتضع معهم هذا الملف المرفق لتشغيل الكود فقط افتح هذا الملف (بعد أن يكون في نفس المجلد مع الملفات الإكسل المطلوب تعديلها) ثم اضغط الزر الذي فيه سيتم إجراء التعديلات المطلوبة والحفظ والغلق لكافة الملفات الإكسل التي في نفس المجلد مع هذا الملف وهذا هو الكود Sub new_Change() Application.DisplayAlerts = False pt = ActiveWorkbook.Path NextFile = Dir(pt & "\") Do While NextFile <> "" If NextFile = "Change.xlsm" Then GoTo 10 Workbooks.Open Filename:=pt & "\" & NextFile 'step-1 [D1:E1].EntireColumn.Delete 'step-2 LR = [B9999].End(xlUp).Row For r = 1 To LR If Cells(r, 2) = "" Or Cells(r, 3) = "" Or Cells(r, 2) = 0 Or Cells(r, 3) = 0 Or IsNumeric( _ Cells(r, 2)) = False Or IsNumeric(Cells(r, 3)) = False Then GoTo 20 If IsNumeric(Cells(r, 2)) Or IsNumeric(Cells(r, 3)) Then Cells(r, 4) = Cells(r, 2) - Cells(r, 3) 'step-3 Cells(r, 3) = Cells(r, 3) * 1000 20 Next r 'step-4 [B1].EntireColumn.Delete '========================= ActiveWorkbook.Save ActiveWorkbook.Close 10 NextFile = Dir() Loop Application.DisplayAlerts = True End Sub ولابد أن يكون اسم الملف كما بالكود "Change.xlsm" تفضل Change.rar رابط هذا التعليق شارك More sharing options...
احمد_محمود قام بنشر سبتمبر 29, 2014 الكاتب مشاركة قام بنشر سبتمبر 29, 2014 شكرا لك استاذ طارق ملف اكثر من رائع و يعمل بصورة جميلة هل من الممكن جعله يقرأ حتى اخر سطر ؟ حاولت تغير قيمة LR الى LR = [b999999].End(xlUp).Row و لكن الملف "يجمد" عند العمل رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر سبتمبر 30, 2014 مشاركة قام بنشر سبتمبر 30, 2014 السلام عليكم أخي العزيز هذا السطر LR = [B9999].End(xlUp).Row يعتمد علي البيانات بالعمود B فإذا كانت البيانات الأكثر لديك بالعمود F مثلا فلتغير الصيغة إلي LR = [F9999].End(xlUp).Row وإن كنت تريد تثبيت الرقم علي 999999 سطر فلتغير للتالي LR = 999999 ولكن هذا سيجعل التنفيذ بطيئا جدا لاأعتقد أنك تستخدم في ملف واحد أكثر من السطر 9999 أي تقريبا 10,000 بيان رابط هذا التعليق شارك More sharing options...
احمد_محمود قام بنشر سبتمبر 30, 2014 الكاتب مشاركة قام بنشر سبتمبر 30, 2014 للأسف لدي مايقارب ال 300000 سطر و على مايبدو ان الملف يحتاج ما يقارب ال 4 دقائق ليتم العملية هل علي ان افعل شيئ ما لجعله اسرع ؟ و سؤال اخر من بعد اذنك ,, هل يمكن تغير لاحقة الملفات ايضا الى .xlsb رابط هذا التعليق شارك More sharing options...
أفضل إجابة طارق محمود قام بنشر سبتمبر 30, 2014 أفضل إجابة مشاركة قام بنشر سبتمبر 30, 2014 (1) ليس مهما عدد الأسطر فقط كما أوضحت لك هذا السطر LR = [b9999].End(xlUp).Row يعتمد علي البيانات بالعمود B فإذا كانت البيانات الأكثر لديك بالعمود F مثلا فلتغير الصيغة إلي LR = [F9999].End(xlUp).Row وعلي هذا سيأخذ البرنامج عدد الأسطر تلقائيا من الورقة (2) وبالنسبة لـ "فعل شيئ لجعله اسرع" نعم يمكنك إضافة سطرين للكود واحد بعد البداية مباشرة Application.ScreenUpdating = False والآخر قبل النهاية مباشرة Application.ScreenUpdating = True ليصبح الكود كالتالي Sub new_Change() Application.ScreenUpdating = False Application.DisplayAlerts = False pt = ActiveWorkbook.Path NextFile = Dir(pt & "\") Do While NextFile <> "" If NextFile = "Change.xlsm" Then GoTo 10 Workbooks.Open Filename:=pt & "\" & NextFile 'step-1 [D1:E1].EntireColumn.Delete 'step-2 LR = [B9999].End(xlUp).Row For r = 1 To LR If Cells(r, 2) = "" Or Cells(r, 3) = "" Or Cells(r, 2) = 0 Or Cells(r, 3) = 0 Or IsNumeric( _ Cells(r, 2)) = False Or IsNumeric(Cells(r, 3)) = False Then GoTo 20 If IsNumeric(Cells(r, 2)) Or IsNumeric(Cells(r, 3)) Then Cells(r, 4) = Cells(r, 2) - Cells(r, 3) 'step-3 Cells(r, 3) = Cells(r, 3) * 1000 20 Next r 'step-4 [B1].EntireColumn.Delete '========================= ActiveWorkbook.Save ActiveWorkbook.Close 10 NextFile = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub ولكن كما تقول 30,000 سطر لابد أن يأخذ وقتا وهذا التعديل سيسرع ذلك قليلا ممكن دقيقتين بدلا من 4 (3) أما السؤال هل يمكن تغير لاحقة الملفات ايضا الى .xlsb نعم فالكود سيفتح أي ملف بالمجلد وهذا سينتج خطأ إذا كان بالمجلد ملفات لايمكن فتحها بالإكسل رابط هذا التعليق شارك More sharing options...
احمد_محمود قام بنشر سبتمبر 30, 2014 الكاتب مشاركة قام بنشر سبتمبر 30, 2014 لك مني خالص الامتنان و التقدير قصدت بتغير الاحقة ان نحفظ الملفات بصيغية جديدة مع الحفاظ على الاسم الاصلي اي باستعمال ActiveWorkbook.Saveas رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر أكتوبر 1, 2014 مشاركة قام بنشر أكتوبر 1, 2014 السلام عليكم أخي الكريم غير نهاية الكود من عند 'step-4 بالإضافة التالية 'step-4 [B1].EntireColumn.Delete '========================= c = WorksheetFunction.Search(".", NextFile) NewFile = Left(NextFile, c - 1) & ".xlsb" ActiveWorkbook.SaveAs Filename:=pt & "\" & NewFile, FileFormat:= _ xlExcel12, CreateBackup:=False ActiveWorkbook.Close 10 NextFile = Dir() Loop Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub رابط هذا التعليق شارك More sharing options...
احمد_محمود قام بنشر أكتوبر 1, 2014 الكاتب مشاركة قام بنشر أكتوبر 1, 2014 شكرا لك من القلب استاذ طارق وفرت عليي الكثير من الوقت و الجهد لك مني خالص الامتنان و التقدير رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.