Note: The other languages of the website are Google-translated. Back to English

كيف تقوم بتشغيل ماكرو في نفس الوقت عبر ملفات مصنفات متعددة؟

في هذه المقالة ، سأتحدث عن كيفية تشغيل ماكرو عبر ملفات مصنف متعددة في نفس الوقت دون فتحها. يمكن أن تساعدك الطريقة التالية في حل هذه المهمة في Excel.

قم بتشغيل ماكرو في نفس الوقت عبر العديد من المصنفات باستخدام التعليمات البرمجية لـ VBA


قم بتشغيل ماكرو في نفس الوقت عبر العديد من المصنفات باستخدام التعليمات البرمجية لـ VBA

لتشغيل ماكرو عبر مصنفات متعددة دون فتحها ، يرجى تطبيق رمز VBA التالي:

1. اضغط باستمرار على ALT + F11 مفاتيح لفتح ميكروسوفت فيسوال باسيك للتطبيقات نافذة.

2. انقر إدراج > وحدة، ولصق الماكرو التالي في ملف وحدة نافذة او شباك.

كود فبا: قم بتشغيل الماكرو نفسه في مصنفات متعددة في نفس الوقت:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

ملاحظة: في الكود أعلاه ، يرجى نسخ ولصق الكود الخاص بك بدون ملف فرعية العنوان و نهاية الفرعية تذييل بين مع Workbooks.Open (xFdItem & xFileName) و انتهت ب نصوص. انظر لقطة الشاشة:

doc تشغيل ماكرو ملفات متعددة 1

3. ثم اضغط F5 مفتاح لتنفيذ هذا الرمز ، و تصفح يتم عرض نافذة ، يرجى تحديد مجلد يحتوي على المصنفات التي تريدها جميعًا لتطبيق هذا الماكرو ، انظر لقطة الشاشة:

doc تشغيل ماكرو ملفات متعددة 2

4. ثم انقر فوق OK زر ، سيتم تنفيذ الماكرو المطلوب مرة واحدة من مصنف واحد للآخرين.

 


أفضل أدوات إنتاجية المكتب

Kutools for Excel يحل معظم مشاكلك ويزيد إنتاجيتك بنسبة 80٪

  • إعادة استخدام: أدخل بسرعة الصيغ المعقدة والرسوم البيانية وأي شيء استخدمته من قبل ؛ تشفير الخلايا مع كلمة السر إنشاء قائمة بريدية وإرسال رسائل البريد الإلكتروني ...
  • سوبر فورميولا بار (بسهولة تحرير أسطر متعددة من النص والصيغة) ؛ تخطيط القراءة (قراءة وتحرير أعداد كبيرة من الخلايا بسهولة) ؛ لصق في النطاق المصفى
  • دمج الخلايا / الصفوف / الأعمدة دون فقدان البيانات ؛ تقسيم محتوى الخلايا ؛ ادمج الصفوف / الأعمدة المكررة... منع تكرار الخلايا؛ قارن النطاقات
  • حدد مكرر أو فريد صفوف حدد صفوف فارغة (جميع الخلايا فارغة) ؛ البحث الفائق والبحث الغامض في العديد من المصنفات. تحديد عشوائي ...
  • نسخة طبق الأصل خلايا متعددة بدون تغيير مرجع الصيغة ؛ إنشاء المراجع تلقائيًا إلى أوراق متعددة أدخل الرموز النقطية، مربعات الاختيار والمزيد ...
  • استخراج النص، إضافة نص ، إزالة حسب الموضع ، إزالة الفضاء؛ إنشاء وطباعة المجاميع الفرعية لترحيل الصفحات ؛ التحويل بين محتوى الخلايا والتعليقات
  • سوبر تصفية (حفظ وتطبيق مخططات التصفية على أوراق أخرى) ؛ فرز متقدم حسب الشهر / الأسبوع / اليوم ، التكرار والمزيد ؛ مرشح خاص بواسطة bold، italic ...
  • اجمع بين المصنفات وأوراق العمل؛ دمج الجداول على أساس الأعمدة الرئيسية ؛ تقسيم البيانات إلى أوراق متعددة; تحويل دفعة xls و xlsx و PDF
  • أكثر من 300 ميزة قوية. يدعم Office / Excel 2007-2021 و 365. يدعم جميع اللغات. سهولة النشر في مؤسستك أو مؤسستك. الميزات الكاملة نسخة تجريبية مجانية لمدة 30 يومًا. ضمان استرداد الأموال لمدة 60 يومًا.
علامة تبويب kte 201905

يجلب Office Tab الواجهة المبوبة إلى Office ، ويجعل عملك أسهل بكثير

  • تمكين التحرير والقراءة المبوبة في Word و Excel و PowerPointوالناشر والوصول و Visio والمشروع.
  • فتح وإنشاء مستندات متعددة في علامات تبويب جديدة من نفس النافذة ، بدلاً من النوافذ الجديدة.
  • يزيد من إنتاجيتك بنسبة 50٪ ، ويقلل مئات النقرات بالماوس كل يوم!
أوفيسيتاب القاع

 

فرز التعليقات حسب
التعليقات (43)
تقييم شنومك من شنومكس · تصنيفات 1
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ماكرو مفيد للغاية ، ويعمل بشكل جيد ، لكني أود أن أكون قادرًا على تحديد الملفات من هذا المجلد التي أريد تشغيل الماكرو عليها؟ لا يتم إنشاء الملفات تلقائيًا في مجلد منفصل ، وأحتاج إلى تشغيل وحدات ماكرو مختلفة على كل مجموعة من الملفات من هذا المجلد ، ثم نقلها مرة أخرى في المجلد الأولي.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
لقد اتبعت التعليمات ولكن حصلت على خطأ في التجميع "Loop wihtout Do". ماذا ينقصني؟ رمز الماكرو الخاص بي بسيط للغاية ، ما عليك سوى تغيير حجم الخط للصفوف المحددة. يعمل بنفسه. هذا ما لدي ... الرجاء المساعدة

التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xFdItem & xFileName)
'رمزك هنا
صفوف ("2: 8"). حدد
مع التحديد
.Name = "Arial"
. الحجم = 12
.Strikethrough = خطأ
. مرتفع = خطأ
.Subscript = خطأ
.OutlineFont = خطأ
الظل = خطأ
. underline = xlUnderlineStyleNone
اللون = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
انتهت ب
xFileName = دير
أنشوطة
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا يارتو
لقد فاتك النص البرمجي "End with" في نهاية التعليمات البرمجية ، يجب أن يكون النص الصحيح كما يلي:
التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xFdItem & xFileName)
'رمزك هنا
صفوف ("2: 8"). حدد
مع التحديد
.Name = "Arial"
. الحجم = 16
.Strikethrough = خطأ
. مرتفع = خطأ
.Subscript = خطأ
.OutlineFont = خطأ
الظل = خطأ
. underline = xlUnderlineStyleNone
اللون = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
انتهت ب
انتهت ب
xFileName = دير
أنشوطة
إنهاء حالة
نهاية الفرعية

من فضلك جربها ، آمل أن تساعدك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
ماكرو مفيد جدًا ، وهو يعمل بشكل رائع ، لكني أود أن أكون قادرًا على تحديد الملفات من هذا المجلد التي أريد تشغيل الماكرو عليها؟ على سبيل المثال ، لدي 4 ملفات في مجلد به ملفات Excel أخرى وأريد تشغيلها فقط على تلك الملفات المحددة الأربعة. كيف يمكنني تعديل الماكرو للسماح لي باختيار هذه الملفات الأربعة من هذا المجلد؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا جويل ،
لتشغيل نفس الكود في مصنفات معينة ، يجب عليك تطبيق الكود أدناه:

التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xFB كسلسلة
مع Application.FileDialog (msoFileDialogOpen)
.AllowMultiSelect = صحيح
مرشحات واضحة
.Filters. إضافة "excel"، "* .xls *"
.تبين
إذا كان .SelectedItems.Count <1 ثم اخرج من Sub
بالنسبة إلى lngCount = 1 To. SelectedItems.Count
xFileName = العناصر المحددة (lngCount)
إذا كان xFileName <> "" ثم
مع Workbooks.Open (اسم الملف: = xFileName)
رمزك
انتهت ب
إنهاء حالة
التالي lngCount
انتهت ب
نهاية الفرعية

من فضلك جربها ، آمل أن تساعدك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
شكرًا ، كان مفيدًا حقًا
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا!

أحاول إدخال الكود الخاص بي في الرمز الخاص بك وعندما أقوم بتشغيل الماكرو ، أعطيني الرسالة التالية: خطأ وقت التشغيل '429': لا يمكن لـ ActiveX إنشاء الكائن. يرجى تقديم المشورة بشأن كيفية إصلاحه. شكرًا لك!

رمز بلدي:

تعيين RInput = النطاق ("A2: A21")
تعيين ROutput = المدى ("D2: D22")

Dim A () كمتغير
ReDim A (1 إلى RInput.Rows.Count، 0)
أ = RInput.Value2

تعيين d = CreateObject ("Scripsting.Dictionary")

بالنسبة إلى i = 1 إلى UBound (A)
إذا كان د موجودًا (أ (ط ، 1)) ثم
د (أ (أنا ، 1)) = د (أ (أنا ، 1)) + 1
آخر
د- أضف أ (ط ، 1) ، 1
إنهاء حالة
التالى
بالنسبة إلى i = 1 إلى UBound (A)
أ (ط ، 1) = د (أ (ط ، 1))
التالى

ROutput = أ
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، شكرًا لك أولاً على هذا الماكرو ، لقد كان بالضبط ما كنت أبحث عنه. ومع ذلك ، لدي مشكلة واحدة ، هل هناك طريقة للإغلاق والحفظ عند اكتمال كل نافذة. لدي كمية كبيرة من الملفات وتنفد ذاكرة الوصول العشوائي لدي قبل اكتمال التنفيذ.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
نعم ، ما عليك سوى إضافة الكود التالي أدناه إذا كنت ترغب في حفظ الملف بنفس الاسم:

"حفظ المصنف
ActiveWorkbook. حفظ
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا كايتلين
ربما يمكن أن يساعدك الرمز أدناه ، في كل مرة بعد تشغيل الكود الخاص بك ، سيظهر مربع مطالبة حفظ الملف لتذكيرك بحفظ المصنف.

التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
خافت xWB كمصنف
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
على خطأ استئناف التالي
القيام أثناء xFileName <> ""
قم بتعيين xWB = Workbooks.Open (xFdItem & xFileName)
مع xWB
'رمزك هنا
انتهت ب
xWB إغلاق
xFileName = دير
أنشوطة
إنهاء حالة
نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا!

أحاول إدخال الكود الخاص بي في الرمز الخاص بك وعندما أقوم بتشغيل الماكرو ، أعطيني الرسالة التالية: خطأ وقت التشغيل '429': لا يمكن لـ ActiveX إنشاء الكائن. يرجى تقديم المشورة بشأن كيفية إصلاحه. شكرًا لك!

رمز بلدي:

تعيين RInput = النطاق ("A2: A21")
تعيين ROutput = المدى ("D2: D22")

Dim A () كمتغير
ReDim A (1 إلى RInput.Rows.Count، 0)
أ = RInput.Value2

تعيين d = CreateObject ("Scripsting.Dictionary")

بالنسبة إلى i = 1 إلى UBound (A)
إذا كان د موجودًا (أ (ط ، 1)) ثم
د (أ (أنا ، 1)) = د (أ (أنا ، 1)) + 1
آخر
د- أضف أ (ط ، 1) ، 1
إنهاء حالة
التالى
بالنسبة إلى i = 1 إلى UBound (A)
أ (ط ، 1) = د (أ (ط ، 1))
التالى

ROutput = أ
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا،

لقد استخدمت هذا الماكرو بنجاح لتنسيق ملفات NBA لـ 30 فريقًا لكل منها كتابه الخاص. بالأمس ، تلقيت رسالة خطأ وأن الوحدة (الماكرو) لا يمكن إكمالها أو حذفها أو تحريرها (ليتم حفظها). لقد أفسد مصنف الماكرو الشخصي الخاص بي وجعل Excel غير قابل للاستخدام تقريبًا بالنسبة لي. إنه يتعطل التطبيق في كل مرة أحاول فيها الوصول إلى ماكرو من أي ملف. لم يكن دعم Excel ودعم Windows قادرين على إصلاح الأشياء. هل يمكنك المساعدة؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هل هناك طريقة يمكنني من خلالها تحديد وجهة الملف في البرنامج النصي نفسه. أريد تخطي العملية 3 حيث يتعين علينا تصفح المجلد المحدد.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، شكرًا على هذا الرمز. هل يمكنك أن تخبرني كيف يمكنني الحصول على نتيجة الماكرو الذي فتحت جميع المصنفات له في ورقة واحدة (نتيجة كل مصنف على التوالي)؟ وهل هناك طريقة لإضافة اسم كل مصنف إلى الصف بالبيانات من الخطوة السابقة؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
Hi

حصلت على خطأ وقت تشغيل aa 1004: بناء الجملة ليس صحيحًا عندما قمت بتشغيل الكود التالي وهو Extend Office VBA لـ "تشغيل ماكرو في نفس الوقت عبر عدة مصنفات برمز VBA" باستخدام Extend Office VBA "احذف جميع النطاقات المسماة مع رمز VBA "في إدخال فتحة الشفرة الخاصة بك:

التكرار الفرعي للملفات ()

خافت xFd كملف الحوار

خافت xFdItem كمتغير

خافت xFileName كسلسلة

قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)

إذا كان xFd.Show = -1 ثم

xFdItem = xFd.SelectedItems (1) & Application.PathSeparator

xFileName = Dir (xFdItem & "* .xls *")

القيام أثناء xFileName <> ""

مع Workbooks.Open (xFdItem & xFileName)

حذف الأسماء الفرعية ()

تحديث 20140314

خافت xName كاسم

لكل xName في Application.ActiveWorkbook.Names

xName.Delete

التالى


انتهت ب

xFileName = دير

أنشوطة

إنهاء حالة

نهاية الفرعية

ما أحاول القيام به هو تشغيل ماكرو يحذف النطاقات المسماة في ثمانية مصنفات موجودة في نفس المجلد.

راجع للشغل ، هذه هي المرة الأولى التي أستخدم فيها شيئًا من Extend Office ولم يعمل. كان هذا الموقع مفيد للغاية بالنسبة لي.

الاقتراحات / التعليقات موضع تقدير كبير.

ألدك
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ، aldc ،
تعمل التعليمات البرمجية الخاصة بك بشكل جيد في المصنف الخاص بي ، ما هو إصدار Excel الذي تستخدمه؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هذا الرمز جيد جدًا ومفيد. أنا استخدامها كثيرا!

في الوقت الحاضر ، في مؤسستي نستخدم SharePoint لتخزين ملفاتنا. هل توجد أي طريقة لجعل هذا الرمز يعمل عبر كافة الملفات الموجودة في مجلد SharePoint؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ، شكرا لك على هذا الرمز.
هل هناك طريقة للتكرار خلال المجلدات الفرعية أيضًا؟ لنفترض أن لدي مجلد واحد وداخل المجلد عشرة مجلدات أخرى يحتوي كل منها على ملف excel.

هل هناك طريقة لتحديد المجلد الأساسي فقط بحيث يتم تشغيل الرمز عبر جميع مجلداته الفرعية؟

شكرا.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، Darko ، لتشغيل رمز من مجلد مع المجلدات الفرعية ، يرجى تطبيق الكود التالي: LoopThroughFiles_Subfolders (xStrPath كسلسلة)
خافت xSFolderName
خافت xFileName
خافت xArrSFPath () كسلسلة
خافت xI كعدد صحيح
إذا كان xStrPath = "" ثم اخرج من Sub
xFileName = Dir (xStrPath & "* .xls *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xStrPath & xFileName)
'رمزك هنا
انتهت ب
xFileName = دير
أنشوطة
xSFolderName = Dir (xStrPath ، vbDirectory)
الحادي عشر = 0
ReDim xArrSFPath (0)
افعل بينما xSFolderName <> ""
إذا كان xSFolderName <> "." ثم xSFolderName <> ".."
إذا كان (GetAttr (xStrPath & xSFolderName) و vbDirectory) = vbDirectory ثم
xI = xI + 1
ReDim Preserve xArrSFPath (xI)
xArrSFPath (xI - 1) = xStrPath & xSFolderName & "\"
إنهاء حالة
إنهاء حالة
xSFolderName = دير
أنشوطة
إذا كان UBound (xArrSFPath)> 0 ثم
بالنسبة إلى xI = 0 إلى UBound (xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath (xI))
التالي الحادي عشر
إنهاء حالة
نهاية الفرعية
التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
إنهاء حالة
End Sub يرجى المحاولة ، آمل أن يساعدك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
بالإضافة إلى الكود أعلاه ، هل من الممكن فتح ملفات Excel بترتيب زمني أرغب فيه؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا أولاً وقبل كل شيء شكرًا جزيلاً على الماكرو الذي يسهل العمل معه حقًا. كنت أتساءل فقط عما إذا كان لدينا طريقة لتحديث المجلد في onedrive من خلال الماكرو. إذا كانت الإجابة بنعم ، هل يمكن أن تخبرني ماذا يمكنني أن أفعل هنا لتحديث الملفات في onedrive باستخدام البرنامج النصي للماكرو؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، شكرًا جزيلاً على هذا البرنامج النصي ، فأنا أعمل جيدًا بالنسبة لي ، لكن لدي احتياجات خاصة: هل هناك طريقة لتغيير البرنامج النصي لتطبيق الكود الخاص بي مع شروط اسم الملف وفي المجلدات الفرعية؟
أشرح: أنا مدرس وقمت بإنشاء حل excel لحفظ نتائج الطلاب والسماح للمعلمين بالتشاور معهم ، وللقيام بذلك ، لدي ملف لكل فئة فرعية بالمدرسة وواحد للفصل المسؤول ، كل ذلك في مجلد لكل فصل.
لذلك عندما أجد خطأ أو تحسينًا ، يتعين علي الإبلاغ عن التغييرات في جميع الملفات في جميع المجلدات الفرعية.
ولكن نظرًا لأن جميع الملفات ليست متطابقة (مؤسسة مختلفة للمجموعات الفرعية) ، فأنا أرغب في طريقة لتطبيق مثال الشفرة الخاص بي على جميع الملفات المسماة "فئة الرياضيات" في جميع المجلدات الفرعية ، أو على العكس من ذلك ، لتطبيق الكود الخاص بي على جميع الملفات في المجلدات الفرعية باستثناء جميع الملفات المسماة "xyz". شكرا! فابريس
تم تصغير هذا التعليق بواسطة المشرف على الموقع
الكود الخاص بك لا يعمل مع VBA التالية ، هل يمكنك المساعدة

خافت vWS كورقة عمل
خافت vA ، vA2 ()
Dim vR As Long ، vSum As Long ، vC As Long
Dim vN As Long ، vN2 As Long ، vN3 As Long

اضبط vWS = ActiveSheet
مع vWS
vR =. الخلايا (عدد الصفوف ، 4) ، النهاية (xlUp) ، الصف
vSum = Application.Sum (.Range ("D2: D" & vR))
ReDim Preserve vA2 (من 1 إلى vSum ، من 1 إلى 4)
vA = .Range ("A2: D" & vR)
لـ vN = 1 إلى vR - 1
لـ vN2 = 1 إلى vA (vN ، 4)
vC = vC + 1
لـ vN3 = 1 To 4
vA2 (vC ، vN3) = vA (vN ، vN3)
التالي vN3
التالي vN2
التالي vN
انتهت ب
vC = 1
من أجل vN = 1 إلى vSum - 2
vA2 (vN ، 4) = vC
إذا كان vA2 (vN + 1 ، 2) = vA2 (vN ، 2) ثم
vC = vC + 1
vA2 (vN + 1 ، 4) = vC
آخر
vA2 (vN + 1 ، 4) = 1
vC = 1
إنهاء حالة
التالي vN
Application.ScreenUpdating = خطأ
الأوراق
مع ActiveSheet
vWS.Range ("A1: D1"). Copy .Range ("A1: D1")
الخلايا (2، 1). الحجم (vSum، 4) = vA2
انتهت ب
Application.ScreenUpdating = ترو

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

خافت vWS كورقة عمل
خافت vA ، vA2 ()
Dim vR As Long ، vSum As Long ، vC As Long
Dim vN As Long ، vN2 As Long ، vN3 As Long

اضبط vWS = ActiveSheet
مع vWS
vR =. الخلايا (عدد الصفوف ، 4) ، النهاية (xlUp) ، الصف
vSum = Application.Sum (.Range ("D2: D" & vR))
ReDim Preserve vA2 (من 1 إلى vSum ، من 1 إلى 4)
vA = .Range ("A2: D" & vR)
لـ vN = 1 إلى vR - 1
لـ vN2 = 1 إلى vA (vN ، 4)
vC = vC + 1
لـ vN3 = 1 To 4
vA2 (vC ، vN3) = vA (vN ، vN3)
التالي vN3
التالي vN2
التالي vN
انتهت ب
vC = 1
من أجل vN = 1 إلى vSum - 2
vA2 (vN ، 4) = vC
إذا كان vA2 (vN + 1 ، 2) = vA2 (vN ، 2) ثم
vC = vC + 1
vA2 (vN + 1 ، 4) = vC
آخر
vA2 (vN + 1 ، 4) = 1
vC = 1
إنهاء حالة
التالي vN
Application.ScreenUpdating = خطأ
الأوراق
مع ActiveSheet
vWS.Range ("A1: D1"). Copy .Range ("A1: D1")
الخلايا (2، 1). الحجم (vSum، 4) = vA2
انتهت ب
Application.ScreenUpdating = ترو

نهاية الفرعية
تم تصغير هذا التعليق بواسطة المشرف على الموقع
حاولت تشغيل الكود ولكن الخطأ "424: Object Required" يظهر في السطر "With Workbooks.Open (xFdItem & xFileName)". من خلال النظر بشكل أعمق ، يبدو أن مصنفات excels المخزنة في مجلد الاهتمام لا تظهر / موجودة (عند فتح النافذة مع عرض الكود ، إذا حاولت فتح المجلد وعدم تحديده ، فهو فارغ). كيف ذلك؟
التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xFdItem & xFileName)
Sheets.Add بعد: = ActiveSheet
الأوراق ("الورقة 2"). حدد
أوراق ("ورقة 2"). الاسم = "رئيسي"
الأوراق ("ماجستير"). حدد
الأوراق ("ماجستير"). التحرك قبل: = الأوراق (1)
انتهت ب
xFileName = دير
أنشوطة
إنهاء حالة
نهاية الفرعية


هل يمكنك مساعدتي في حل هذه المشكلة؟
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هذا هو موقع الويب المفضل لدي بأوضح التعليمات (أكثر من أي مقطع فيديو على YouTube) وأستمر في العودة إليه مرارًا وتكرارًا. شكرًا جزيلاً على هذه الدروس - فأنت منقذ لطالب خريج حزين.
تم تصغير هذا التعليق بواسطة المشرف على الموقع
التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xFdItem & xFileName)
"ActiveCell.Offset (0، 1). Columns (" A: A "). EntireColumn.Select
Selection.Insert Shift: = xlToRight
ActiveCell. حدد
انتهت ب
xFileName = دير
أنشوطة
إنهاء حالة
End Sub ، الرجاء المساعدة. راجع للشغل ، امتداد ملفات Excel الخاص بي هو (.csv - "محدد بفاصلة"). ولدي 500 ملف إكسل في مجلد يبلغ متوسط ​​عدد الصفوف 500000 تقريبًا .. الرجاء المساعدة. أريد فقط إدراج عمود في كل مصنف
تم تصغير هذا التعليق بواسطة المشرف على الموقع
هل حصلت على إجابة لسؤالك؟ أحاول أن أفعل نفس الشيء لأكثر من 3700 ملف csv. أريد فقط إضافة عمود واحد (أ).
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، محتاج وكارلي ، لحل مشكلتك ، لتشغيل الكود لملفات CSV متعددة ، ما عليك سوى تغيير امتداد الملف .xls إلى .csv كما هو موضح أدناه: التكرار الفرعي للملفات ()
خافت xFd كملف الحوار
خافت xFdItem كمتغير
خافت xFileName كسلسلة
قم بتعيين xFd = Application.FileDialog (msoFileDialogFolderPicker)
إذا كان xFd.Show = -1 ثم
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .csv *")
القيام أثناء xFileName <> ""
مع Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset (0، 1) .Columns ("A: A"). EntireColumn.Select
Selection.Insert Shift: = xlToRight
ActiveCell. حدد
انتهت ب
xFileName = دير
أنشوطة
إنهاء حالة
End Sub يرجى المحاولة ، آمل أن يساعدك!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبًا ، هل من الممكن تشغيل الماكرو فقط في أوراق المصنفات المختلفة باسم معين؟ شكرًا!!
تم تصغير هذا التعليق بواسطة المشرف على الموقع
مرحبا ساره،
عذرا ، لا يوجد حل جيد للمشكلة التي أثارتها.
شكرا!
لا توجد تعليقات منشورة هنا حتى الآن
عرض المزيد
اترك تعليقاتك
النشر كضيف
×
قيم المنشور:
0   الشخصيات
المواقع المقترحة

تواصل معنا

حقوق التأليف والنشر © 2009 - شبكة الاتصالات العالمية.extendoffice.com. | كل الحقوق محفوظة. مشغل بواسطة ExtendOffice. | | خريطة الموقع
Microsoft وشعار Office هما علامتان تجاريتان أو علامتان تجاريتان مسجلتان لشركة Microsoft Corporation في الولايات المتحدة و / أو دول أخرى.
محمي بواسطة Sectigo SSL