asam1122 قام بنشر يونيو 5, 2013 مشاركة قام بنشر يونيو 5, 2013 الاخوه الافاضل جزاكم الله خير على المساعده مرفق لكم ملف يحتوي على صفحتين او شيتين الصفحه الاولى تحتوي على رقم البند و اسم البند و تاريخ الصلاحية للبند الصفحة الثانية هي التي اريد العمل عليها يوجد في اول الصفحه سطرين السطر الاول مكتوب به رقم البند وتركت بعده فراغ وكذلك يوجد في السطر الثاني اسم البند وتركت بعده فراغ ما اريد عمله هو التالي 1- عند كتابه رقم البند في الصفحه الثانيه في الفراغ الموضوع بجانب رقم البند ان يظهر لي كافة البنود التي بنفس رقم البند في الصفحه الرئيسيه مرتبه بتاريخ الصلاحيه بالاحدث اولا . اتمنى اني وضحت المطلوب ولكم مني كل الشكر مقدما Microsoft Office Excel Worksheet جديد .rar رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 5, 2013 مشاركة قام بنشر يونيو 5, 2013 السلام عليكم تفضل المرفق Microsoft Office Excel Worksheet جديد2.rar رابط هذا التعليق شارك More sharing options...
جمال عبد السميع قام بنشر يونيو 5, 2013 مشاركة قام بنشر يونيو 5, 2013 أخى الحبيب وبعد إذن أستاذى( طارق محمود ) وزيادة فى إثراء الموضوع هذا حل أخر بالمعادلات microsoft Office.rar رابط هذا التعليق شارك More sharing options...
asam1122 قام بنشر يونيو 9, 2013 الكاتب مشاركة قام بنشر يونيو 9, 2013 جزاكم الله خييييييييير فعلا مبدعين اشكركم من كل قلبي شكرا لك اخي جمال عبد السميع وشكرا لك اخي طارق محمود ولكن اذا سمح وقتك اخي محمود اريد منك اضافة بعض الشرح على الكود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address <> "$B$1" Then Exit Sub Application.ScreenUpdating = False s = [B1] With Sheet1 .Range("$A$1:$C$999").AutoFilter Field:=1, Criteria1:=s LR = .[A9999].End(xlUp).Row .Range("A1:C" & LR).Copy [E2] Application.CutCopyMode = False .Range("$A$1:$C$999").AutoFilter End With [B2] = [F3]: [A7:C999].ClearContents LR = [E9999].End(xlUp).Row With Range("E3:G" & LR) .Sort Key1:=[G3], Order1:=xlAscending .Copy [A7] End With [E2:G999].ClearContents Application.ScreenUpdating = True End Sub وهل عند نقل الموديول الى ملف ااخر هل يحتاج الى تعديل ام فقط نعدل في الكود الخاص بالشيت وشكرا مقدما رابط هذا التعليق شارك More sharing options...
عبدالله المجرب قام بنشر يونيو 9, 2013 مشاركة قام بنشر يونيو 9, 2013 السلام عليكم بعد إذن الاستاذ طارق هذا شرح للكود If Target.Address <> "$B$1" Then Exit Sub شرط اذا لم يكن عنوان الخلية النشطة B1 يتم الخروج من الاجراء ==================================== Application.ScreenUpdating = False إيقاف اهتزاز الشاشة =================================== s = [B1] المتغير S يساوي قيمة الخلية B1 والتي تمثل رقم البند ================================== With Sheet1 تقدر تقول (مع الورقة الاولى) ويتم التعامل مع هذه الورقة دون الذهاب اليها ================================== .Range("$A$1:$C$999").AutoFilter Field:=1, Criteria1:=s تصفية تلقائية للمدى Range("$A$1:$C$999") في العمود الأول وبشرط المتغير S (طبعاً التصفية للمدى في الورقة الأولى) ==================================================== LR = .[A9999].End(xlUp).Row متغير يساوي رقم الصف الأخير الذي به بيانات بعد التصفية =================================================== .Range("A1:C" & LR).Copy [E2] نسخ المدى A1:C ورقم أخر صف به بيانات في الورقة الأولى ولصقه في الخلية E2 من الورقة الثانية ============================================== Application.CutCopyMode = False الغاء وضع الصق والنسخ ============================================== .Range("$A$1:$C$999").AutoFilter End With إنهاء وضع التصفية التلقائية في الورقة الأولى واغلاق التعامل مع هذه الورقة =========================================== [B2] = [F3]: [A7:C999].ClearContents قينة الخلية B2 تساوي الخلية F3 ويتم مسح البيانات من المدى [A7:C999] ============================================ LR = [E9999].End(xlUp).Row متغير لتحديد رقم أخر صف به بيانات في العمود E من الورقة الثانية =========================================== With Range("E3:G" & LR) .Sort Key1:=[G3], Order1:=xlAscending .Copy [A7] End With في المدى E3:G وأخر صف يتم فرزه حسب العمود G تنازلياً نسخ البيانات في هذا المدى ولصقها في الخلية A7 انها التعامل مع هذا المدى ========================================== [E2:G999].ClearContents Application.ScreenUpdating = True مسح البيانات في المدى E2:G999 (وهو المدى الذي تم لصق البيانات فيه) تفعيل اهتزلز الشاشة ============================================ ان شاء الله أكون وفقت في الشرح 1 رابط هذا التعليق شارك More sharing options...
أفضل إجابة عبدالله المجرب قام بنشر يونيو 9, 2013 أفضل إجابة مشاركة قام بنشر يونيو 9, 2013 ولاثراء الموضوع هذا كود مختصر Private Sub Worksheet_Change(ByVal Target As Range) Dim Cl As Range If Not Intersect(Target, [B1]) Is Nothing Then [A7:C999].ClearContents For Each Cl In Sheets("الرئيسيه").Range("A2:A" & Sheets("الرئيسيه").[A10000].End(xlUp).Row) If Cl = Target Then Cl.Resize(1, 3).Copy Range("A" & [A10000].End(xlUp).Row + 1) Next End If End Sub رابط هذا التعليق شارك More sharing options...
طارق محمود قام بنشر يونيو 9, 2013 مشاركة قام بنشر يونيو 9, 2013 السلام عليكم أخي الحبيب / أبامحمود (جمال عبد السميع) ملك المعادلات (مع أني لم أشاهد بعد) أن حلك رائع كما تعودنا جزاك الله خيرا ووفقك دائما لما يحب ويرضي أخي العظيم / أباأحمد (عبدالله المجرب) ماشاء الله وفقت تماما في الشرح لم أكن لأشرح الكود مثلما فعلت والكود الأخير (مع أني لم أفحصه) أفضل بالتأكيد جزاك الله خيرا ووفقك دائما لما يحب ويرضي رابط هذا التعليق شارك More sharing options...
جمال عبد السميع قام بنشر يونيو 9, 2013 مشاركة قام بنشر يونيو 9, 2013 أستاذى ومهندس منتدانا العظيم ( طارق محمود ) شرف كبير من حضرتك هذه الثقة الكبيرة فيه وإن كنت أتمنى أن أكون نقطة فى بحر علمك لأن حضرتك من أساتذتى الذى أفخر بهم وأعتز بارك الله فيك أستاذى وأكثر الله من أمثالك لأن حضرتك مثل يحتذى فى العلم والخلق والتواضع رابط هذا التعليق شارك More sharing options...
asam1122 قام بنشر يونيو 10, 2013 الكاتب مشاركة قام بنشر يونيو 10, 2013 شكرا لكم من اعماق قلبي على مابذلتموه معي من مجهود شكرا لكم جميعا لكل من تعب في كتابة كود شكرا جزيلا لكل من شرح كود شكرا جزيلا لكل من حاول مساعدتي شكرا لك اخي طارق محمود شكرا لك اخي جمال عبد السميع شكرا لك اخي عبد الله المجرب جزاكم الله خيرا لا اعرف كيف ارد معروفكم لكن الله ييسر لكم ويرزقكم من واسع فضله ويسهل جميع اموركم رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان