Ali Mohamed Ali

جرب هذا أخى Consumption.xlsx

أنا بصراحة عندى الإكسيل 2007 وهى تعمل عندى بكل بساطة -فلا يوجد عندى 2010 كى اجربها لك ولكن لا أعتقد أنها لا تعمل عليه فانها معادلة بسيطة من if ممكن تحاول تستخدم معادلة الأستاذ سليم

وعليكم السلام نفضل أخى احصاء.xlsx

السلام عليكم معلش إتاخرت عليك رجاءا أن تترك رقم الصفحات بالترتيب يبدأ بأى رقم تريده بعد رقم 1 والترتيب بعد ذلك يكون متسلسل ولكم منى جزيل الشكر ترحيل.xlsm

طبعا ممكن بس غير اسم الصفحة برقم الموظف وفعلا قابل للزيادة كل ماتحتاج تفتح صفحة جديدة قم بفتحها وسميها برقم الموظف والكود بالفعل سيعمل

السلام عليكم مرحبا بك فى المنتدى الكريم هذا الملف لضريبة كسب العمل- من تصميم خبيرنا فى الإكسيل :الأستاذ محمد الريفى كل السلام والتحية له ضريبة كسب العمل.xlsx

تفضل هذا الملف ولكن لابد أن تقوم يتغيير أسماء الصفحات الى أسماء الموظفين لديك بشكل مساوى لما هو وارد بجهاز البصمة فبناءاً عليه يكون الترحيل من الصفحة الرئيسية الى كل موظف على حده كود ترحيل بدون تكرار من صفحة إلى عدة صفحات.xlsm

تفضل أخى شرح المعادلة يارب يكون كافى وواضح : Book1.xlsx

على سبيل المثال فهذا أول كود : Sub ali_Fail_Students() Sheets("ÇáäÇÌÍæä").Range("a6:aq100") = "" Sheets("ÇáäÇÌÍæä").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("ÊÌãíÚí").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("ÇáäÇÌÍæä").[A1000].End(xlUp).Row + 1 If Sheets("ÊÌãíÚí").Range("au" & T).Value = "äÇÌÍ" Then Sheets("ÇáäÇÌÍæä").Range("a" & Y) = Sheets("ÊÌãíÚí").Range("E" & T).Value Sheets("ÇáäÇÌÍæä").Range("d" & Y) = Sheets("ÊÌãíÚí").Range("g" & T).Value Sheets("ÇáäÇÌÍæä").Range("c" & Y) = Sheets("ÊÌãíÚí").Range("f" & T).Value Sheets("ÇáäÇÌÍæä").Range("e" & Y & ":aq" & Y) = Sheets("ÊÌãíÚí").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub وذلك الكود الثانى : Sub rakan_Fail_Students() Sheets("ÑÇÓÈ").Range("a6:aq100") = "" Sheets("ÑÇÓÈ").Range("a6:aq100").Interior.ColorIndex = 0 Application.ScreenUpdating = False X = Sheets("ÊÌãíÚí").[e1000].End(xlUp).Row For T = 11 To X Step 3 Y = Sheets("ÑÇÓÈ").[A1000].End(xlUp).Row + 1 If Sheets("ÊÌãíÚí").Range("au" & T).Value = "áå ÏæÑ ËÇä Ýì" Then Sheets("ÑÇÓÈ").Range("a" & Y) = Sheets("ÊÌãíÚí").Range("E" & T).Value Sheets("ÑÇÓÈ").Range("d" & Y) = Sheets("ÊÌãíÚí").Range("g" & T).Value Sheets("ÑÇÓÈ").Range("c" & Y) = Sheets("ÊÌãíÚí").Range("f" & T).Value Sheets("ÑÇÓÈ").Range("e" & Y & ":aq" & Y) = Sheets("ÊÌãíÚí").Range("j" & T + 2 & ":av" & T + 2).Value Else End If Next Clear_and_Highlight Application.ScreenUpdating = True End Sub ولدمجهم أو استدعائهم بزر واحد نستخدم هذا الكود الضغير: Sub Test() Call ali_Fail_Students Call rakan_Fail_Students End Sub ملحوظة كود الدمج للنابغة أستاذنا الغالى ياسر خليل أبو البراء جزاه الله كل خير وجعله دائما زخرا لنا وفى ميزان حسناته دائما وهذا مثال أخر لدمج الكواد للعلامة أستاذنا العزيز بن علية حاجي Code Merge.xlsm

وعليكم السلام أخى مرحبا بك فى منتدانا الكريم لو إفترضنا ان الرقم المستخدم فى المعادلة موجود فى الخلية B1 فالمعادلة كالتالى : IF((B1*28/100)>100,100,(B1*28/100))= بارك الله فيك

ممكن تجرب هذا Book1.xlsx

وعليكم السلام تفضل هذا اللى توصلت اليه طلب كود لعمل filter لتاريخ.xlsm

ولإثراء الموضوع جرب هذا خطابات الضمان 2018.xls

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

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

بارك الله فيك وجزيت خيرا

وعليكم السلام تفضل أخى لك ما طلبت تنقيط تلاميذ الفصل 2 .xlsx

جرب أخى بعد عمل التنسيق المطلوب التقويم الهجري3.rar

أخى ممكن تجرب هذا Delivery 2018.xlsm

بارك الله فيك وجزاك خيرا وجعله فى ميزان حسناتك

تمام أستاذى سليم بارك الله فيك

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

بارك الله فيك وجزيت خيرا كثيرا

تفضل أخى الفيديو موجود hh.rar

السلام عليكم أخى جرح- هل هذا طلبك ؟ لقد تم بوضع هذا الكود بعد عمل الكمبوبوكس Private Sub ComboBox1_Change() Dim arr As Variant, i As Long Dim Sh As Worksheet For Each Sh In Worksheets If ComboBox1.Value = Sh.Name Then Sh.Activate End If Next End Sub Private Sub ComboBox1_Click() End Sub Private Sub ComboBox1_GotFocus() Dim arr As Variant, i As Long Dim Sh As Worksheet For Each Sh In Worksheets If Sh.Name <> "TOC" Then i = i + 1 ReDim arr(i, 1) arr(i, 1) = Sh.Name ComboBox1.AddItem arr(i, 1) End If Next End Sub