ياسر خليل أبو البراء

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

بارك الله فيك أستاذي الكبير محمد صالح على حلولك الرائعة ، والله لقد دبت الروح في المنتدى بعد عودتك إليه سؤال لما استخدمت الحلقات التكرارية في كودك الأخير .. في حين يمكن عدم استخدامها بهذا الشكل Sub AddKasr() Dim c As Long c = Cells(Rows.Count, "AR").End(xlUp).Row With Range("AN8:AN" & c) .ClearContents .Value = Range("AR8:AR" & c).Value End With MsgBox "OK" End Sub

جرب تنصيب النت فريم ورك 3.5 ... أعتقد أن هذا كفيل بحل المشكلة إن شاء العلي القدير

تعديل طفيف جداً في الكود .. والكود يعمل بشكل جيد لدي (ويندوز 7 ونسخة أوفيس 2016) Option Base 1 Sub GiveUniques() Dim j As Long Dim x As Long Dim First_Sh As Worksheet Dim Sec_Sh As Worksheet Dim sn As Variant Dim Obj As Object Set First_Sh = Sheets("بيانات الطلبة"): Set Sec_Sh = Sheets("اوائل ") sn = First_Sh.Range("V7:V" & First_Sh.Cells(Rows.Count, "v").End(xlUp).Row) With CreateObject("System.Collections.ArrayList") For j = 1 To UBound(sn) If sn(j, 1) <> vbNullString Then If Not .Contains(sn(j, 1)) Then .Add sn(j, 1): x = x + 1 End If Next j .Sort Sec_Sh.Range("S9").Resize(x) = Application.Transpose(.toarray) End With End Sub أعتقد المشكلة في النت فريم ورك لأنك تعمل على نسخة إكس بي .. جرب تنصيب أحدث نسخة للنت فريم ورك ومتوافقة مع إكس بي (ممكن يفيدنا بالموضوع أحد خبراء التعامل مع ويندوز إكس بي) .NET Framework Supported in: 4, 3.5, 3.0, 2.0, 1.1, 1.0

ممكن ترفق الملف الذي به المشكلة وتصور رسالة الخطأ التي تظهر لك مع ظهور السطر الأصفر .. ما هي نسخة الويندوز التي تعمل عليها ونسخة الأوفيس التي تعمل عليها؟

نعم أخي ناصر ولكن لابد أن تكون متأكد أن الضغط على Ctrl + A من لوحة المفاتيح سيحدد النطاق المطلوب العمل عليه بشكل صحيح لكي لا تحدث مشاكل أو يمكنك الاعتماد على الطريقة الثانية فهي أضمن وأفضل إذا لم تكن متأكد من النطاق الحالي

جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim i As Long Dim j As Long Dim x As Long Set ws = Feuil1 Set sh = Sheet1 Application.ScreenUpdating = False sh.Range("B7:J" & Rows.Count).Clear For i = 7 To ws.Cells(Rows.Count, 3).End(xlUp).Row If ws.Cells(i, 3).Value = sh.Cells(4, 3).Value Then For j = 5 To 155 Step 5 sh.Range("B" & x + 7).Value = ws.Cells(6, j).Offset(-1).Value ws.Range("B" & i & ":D" & i).Copy sh.Range("C" & x + 7) ws.Cells(i, j).Resize(1, 5).Copy sh.Range("F" & x + 7) x = x + 1 Next j Exit For End If Next i With sh.Range("B7:B" & Rows.Count) .NumberFormat = "d-mmm" .Interior.Color = RGB(255, 255, 153) .Borders.Value = 1 End With Application.CutCopyMode = False Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub

بارك الله فيك أخي العزيز ناصر بالنسبة لطلبك تم تناوله في فيديو سابق على الرابط التالي (يمكن إضافة شروط أو إضافة علامة النجمة للنص المطلوب كشرط ليكون أعم

بارك الله فيك أخي العزيز ناصر ..الحمد لله أن تم المطلوب على خير والحمد لله الذي هدانا لهذا وما كنا لنهتدي لولا أن هدانا الله تقبل وافر تقديري واحترامي

وعليكم السلام ممكن ترفق شكل بعض النتائج المتوقعة ..ليسهل تقديم المساعدة من قبل إخوانك بالمنتدى

لإدخال معادلة في الإكسيل حدد الخلية واكتب علامة يساوي وابدأ في كتابة المعادلة لديك مثال =SUM(A1:A10) حيث تقوم المعادلة بجمع النطاق A1:A10 ... تقبل تحياتي

أخي العزيز ناصر حاول تتبع الكود باستخدام مفتاح F8 من لوحة المفاتيح لتلاحظ التغيرات التي تحدث بعد كل سطر سأعطيك مثال من الكود لتعرف الأجزاء المهمة في السطر 'رقم عمودالبيانات الفريده ورقم عمود بيانات المصدر Cells(U, 22) = Sheets("رصد الترم الثانى").Cells(U, 4) هذا السطر يلي السطر الذي يقوم بعمل حلقة تكرارية من الصف رقم 7 'اسم شيت المصدرورقم صف البدايه في شيت المصدر For U = 7 To Sheets("رصد الترم الثانى").[C1500].End(xlUp).Row فالمتغير المسمى U يحمل في أول حلقة تكرارية القيمة 7 ... من ثم فإن السطر الذي أعطيك مثالاً له يكون بالشكل التالي إذا قمنا بترجمته Cells(7, 22) = Sheets("رصد الترم الثانى").Cells(7, 4) الشق الأول لا توجد فيه إشارة لورقة العمل حيث أن الكود موضوع في حدث تنشيط ورقة العمل Worksheet_Activate ، فإنه يفهم أن الخلية في الصف رقم 7 والعمود 22 في الورقة التي تحتوي الكود (الورقة الهدف) التي توضع فيها القيم الفريدة والشق الثاني يشير للورقة المصدر التي تحتوي البيانات الخام في الصف السابع والعمود الرابع كيف يمكن أن أغير صف البداية في ورقة العمل المصدر أو الهدف ؟ ببساطة يمكنك التحكم في المتغير U حيث يمكنك إضافة قيمة محددة ... على سبيل المثال إذا كانت البيانات الخام تبدأ من الصف رقم 10 فإنه في الجزء الذي يتعامل مع البيانات الخام يتم إضافة 3 لقيمة المتغير U لتحصل على الرقم 10 ، ليكون بهذا الشكل Cells(U, 22) = Sheets("رصد الترم الثانى").Cells(U+3, 4) هذا مجرد مثال لتتضح الصورة ، ويمكنك تطويع الكود كما ترغب حسب هيكلة وحالة الملف وتقبل تحياتي

ممكن تصمم شكل النتائج المتوقعة في ورقة جديدة ..كدليل لمن يريد تقديم المساعدة

عندما يفتح ملف الإكسيل أو أي ملف يخص معظم تطبيقات الأوفيس فإن هناك ملف وهمي ينشأ في الجهاز ، ويكون مخفي .. وهو ملف مؤقت :: قد تكون النسخة الأصلية حدثت بها مشكلة أثناء فتح الملف المؤقت كانقطاع كهرباء أو لأي سبب مما أدى إلى تلف الملف بشكل جزئي وظهور تلك الرسالة ، وعندما قمت بنسخ الملف الأصلي قام الجهاز بإنشاء نسخة وهمية جديدة بلا مشاكل فيها .. هذا والله أعلى وأعلم (وفوق كل ذي علمٍ عليم)

ممكن ترفق الملف للإطلاع عليه ومحاولة فهم المشكلة بشكل أعمق

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

قمت بالإطلاع على ملفك المرفق ولم أفهم المطلوب .. طلبك أن يتم التعامل مع 1500 ملف في نفس الوقت والكود المقدم يقوم بعمل حلقة تكرارية للملفات كلها ثم في المكان المخصص في الكود يمكنك فعل ما توده من تنسيق أو خلافه مرة واحدة لكل الملفات .. على سبيل المثال إذا أردت توسعة عرض العمود الأول في الـ 1500 ملف ستضع سطر يقوم بذلك الأمر .Columns(1).ColumnWidth=25 ويمكنك تسجيل ماكرو للتنسيق المطلوب لتتعرف على كيفية التعامل مع أسطر الكود في حالة التعامل مع التنسيق أو خلافه

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

وعليكم السلام جرب حفظ الملف باسم آخر في مسار آخر .. وإذا استمرت المشكلة تأكد أن البارتشن الذي يحفظ عليه الملف ليس للقراءة فقط

اضغط على alt+F11 للدخول لمحرر الأكواد ومن نافذة المشروع في الجهة اليسرى انقر نقراً مزدوجاً على thisWorkbook ثم انسخ الكود والصقه هناك للمزيد حول الأساسيات قم بالإطلاع على رابط الفيديو التالي

وعليكم السلام جرب الكود التالي ..ضع ما تريد من أكواد مكان سطر التعليق في الكود Sub LoopThroughClosedWBs() Dim wbk As Workbook Dim folderPath As String Dim fileName As String Dim founter As Double folderPath = ThisWorkbook.Path & "\" fileName = Dir(folderPath & "*.xl*") Application.ScreenUpdating = False Application.Calculation = xlManual Do While fileName <> "" If fileName <> ThisWorkbook.Name Then Set wbk = Workbooks.Open(folderPath & fileName) With wbk.Sheets("Sheet1") 'Your Stuff End With wbk.Close SaveChanges:=True End If fileName = Dir() Loop Application.Calculation = xlAutomatic Application.ScreenUpdating = True MsgBox "Finished ...", 64 End Sub

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

ارفق ملف

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات تقبل تحياتي

السلام عليكم جرب الكود التالي في حدث ورقة العمل Private Sub Worksheet_Activate() ActiveSheet.TextBox1.Activate End Sub