الشيباني1 قام بنشر يناير 16, 2012 قام بنشر يناير 16, 2012 اخواني الاعزاء تحية طيبه ارجو المساعده في كود يعمل تلقائيا لملء الخلايا الفارغه التي يوضحها الملف المرفق مع الامتنان
الشيباني1 قام بنشر يناير 16, 2012 الكاتب قام بنشر يناير 16, 2012 استاذنا العزيز مع تقديري يتم ملؤها بالبيانات التي قبلها مع الشكر
طارق محمود قام بنشر يناير 16, 2012 قام بنشر يناير 16, 2012 السلام عليكم أنظر طريقة سريعه في الفيديو المرفق فلتر (تصفية) ، فرز للفراغات عمل معادلة أن الخلية تساوي مافوقها مليء المعادلة لليمين ولأسفل أثناء الفلتر حذف الفلتر وممكن تعمل بعد كده نسخ / لصق خاص قيم فقط أنظر الفيديو المرفق Fill down.rar 1
طارق محمود قام بنشر يناير 16, 2012 قام بنشر يناير 16, 2012 ولو مصمم علي كود تظلل المساحة التي بها فراغات ثم تطلب تشغيل هذا الكود Sub xx() For Each r In Selection If r.Value = "" Then r.Value = r.Offset(-1, 0).Value Next r End Sub
عبدالله المجرب قام بنشر يناير 16, 2012 قام بنشر يناير 16, 2012 السلام عليكم اضافة الى حل الاخ الفاضل طارق عملت هذا الكود ولكن يشترط ان تكون اسماء المواد غير متشابهة (وانا افترضتها تبداء من A ثم B حتى تنتهي ب M) فكان هذا الكود جربه يمكن ينفع Sub Abu_Ahmed() Dim c As Range For Each c In [E6:E18] Select Case c.Value Case "B", "C", "D", "E": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next Case "G", "H", "I": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next Case "K", "L", "M": For i = -3 To -1 c.Offset(0, i) = c.Offset(-1, i) Next End Select Next End Sub
الشيباني1 قام بنشر يناير 17, 2012 الكاتب قام بنشر يناير 17, 2012 اساتذتنا الكرام مع جزيل شكري وتقديري ما وددت ايضاحه انني لا ارغب بزر امر للكود بل كود يعمل ( ان كان ذلك ممكنا ) بمجرد ادخال البيانات في اسطر محدده في المرفق وانا لدي الكود ادناه والذي يعمل بزر امر والذي استخدمه في موضوع آخر ارجو قبول اعتذاري عن طلبي اجراء تعديل عليه ليعمل بدون زر مع الامتنان Sub Fill_1() Application.Calculation = xlCalculationManual Dim LastR As Long LastR = Range("E" & Rows.Count).End(xlUp).Row Range("c5:c" & LastR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" Range("d5:d" & LastR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" Application.Calculation = xlCalculationAutomatic End Sub
طارق محمود قام بنشر يناير 17, 2012 قام بنشر يناير 17, 2012 السلام عليكم في هذه الحالة إستخدم نفس الكود في حدث الصفحة كالتالي Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column < 3 Or Target.Column > 5 Then Exit Sub On Error Resume Next Application.Calculation = xlCalculationManual Dim LastR As Long LastR = Range("E" & Rows.Count).End(xlUp).Row Range("c5:c" & LastR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" Range("d5:d" & LastR).SpecialCells(xlCellTypeBlanks).Formula = "=R[-1]C" Application.Calculation = xlCalculationAutomatic End Sub
الشيباني1 قام بنشر يناير 17, 2012 الكاتب قام بنشر يناير 17, 2012 استاذنا العزيز مع جزيل شكري ارجو تضمين مثالي اعلاه كودكم الرائع لاني لم اتمكن من تعديله مع الامتنان
الشيباني1 قام بنشر يناير 17, 2012 الكاتب قام بنشر يناير 17, 2012 اشكرك جدا استاذنا الكبير وادامك الرحمن لنا مرجعا
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.