عبدالله المجرب

السلام عليكم جرب المرفق لو أخرت تاريخ الكمبيوتر (لن يعمل الملف) تاريخ إنتهاء الملف 28/6/2013 وضعت فترت العد من 1-3 أيام بسبب أيام الإجازات (اي ان الملف لو بقي يومين مغلق وفتح سيتم تعديل تاريخ المرجع الى التاريخ الجديد ولكن لو أكثر من ثلاثة أيام سيتم إعتبار الملف منتهي salary finished.rar

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

ان شاء الله سأكمل السلسلة فانتظروني قريباً جداً درس جديد

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

هذا الموضوع يساعدك للوصول الى ما تريد http://www.officena.net/ib/index.php?showtopic=42107&hl=

تم فصل الموضوع ================= السلام عليكم اليك المرفق فيه دالة معرفة Function MyCount(MyRng As Range, MyVal As Range) For Each cl In MyRng For Each R In Split(cl.Value, " ") If R = MyVal Then conter = conter + 1 Next Next MyCount = conter End Function شاهد المرفق عد تكرار اسم معين.rar

اخي الفاضل ضع مرفق ليوضح المطلوب

أخي انا جربت الملف وقمت بنسخ 1000 صف مرتين وكانت النتيجة رائعة

هذه الدوائر لا تظهر في الطباعة

السلام عليكم ورحمة الله وبركاته بناءً على طلب الاخوة الكرام ارفق لكم شرح لهذه الطريقة احببت أن يكون الموضوع منفصلاً للفائدة ولا تنسونا من صالح دعائكم كما أذكركم بالدعاء لاهلنا في سوريا بأن يرفع الله الظلم عنهم

هل يمكن بعد إذنك وضع رابط الموضوع

معادلات رائعة وتطويع متقن ============= بارك الله فيك استاذ جمال

السلام عليكم اليك هذا التعديل الطفيف على الكود Sub Button12_Click() TT = 4 Do Until Cells(TT, "BN").Value = "" TT = TT + 1 Loop Range(Cells(2, "BG"), Cells(TT - 1, "BN")).Select Selection.PrintOut Copies:=1, Preview:=True, Collate:=True End Sub Sub Button13_Click() TT = 4 Do Until Cells(TT, "BN").Value = "" TT = TT + 1 Loop Range(Cells(2, "BG"), Cells(TT - 1, "BN")).Select Selection.PrintOut Copies:=1, Collate:=True End Sub

ولاثراء الموضوع هذا كود مختصر 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

السلام عليكم بعد إذن الاستاذ طارق هذا شرح للكود 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 (وهو المدى الذي تم لصق البيانات فيه) تفعيل اهتزلز الشاشة ============================================ ان شاء الله أكون وفقت في الشرح

الافضل ان يكون سطر أختيار الورقة قبل ظهور الفورم

لا فتوى بعد فتوى ابوعلي فالفورم من ابداعاته

معادلات قيمة جزاك الله كل خير اخي مرعي

المطلوب غامض فارجو ايضاحه بمرفق

تمت الاجابة بارك الله فيك اخي ابراهيم

بارك الله فيك استاذ احمد على هذه المعلومات القيمة

ما شاء الله إبداع متواصل سلمت يمينك ابا علي

اللهم انا نسألك لابن اخينا شفاءا بلا سقم اللهم اشفه ...آمين ...آمين...آمين

بارك الله فيك استاذ رجب وشكراً على اللفته الكريمة

السلام عليكم في المرفق تم استعمال التنسيق الشرطي لاضافة خط للدرجات الاقل من 50 جرب عدل درجة اي خلية مرة الى اعلى من 50 ومرة الى اقل من 50 ولاحظ النتيجة اندر لاين.rar