أ / محمد صالح

عليكم السلام ورحمة الله وبركاته
حسب فهمي للمطلوب
جرب تغيير هذا السطر
For Cell = startRow To .Range(myArray(x) & startRow).End(xlDown).Row Step 2 إلى
For Cell = startRow To .Range(myArray(x) & Rows.Count).End(xlUp).Row Step 2 بالتوفيق

لا تتعب نفسك
الاكسل ضعيف في الحماية
اقل من الأكسس

عليكم السلام ورحمة الله وبركاته
مادامت النتائج في النموذج صحيحة
إذن ينبغي جعل معادلات الشيت مثل النموذج
تم ضبط معزم معادلات الشيت في حالة وجود خطأ في البحث باستخدام Iferror
وتم تعديل معادلات الخلايا H19 & I19 & L19 وإضافة معادلات في H20 & I20 ليتم الحساب بعد إضافة الدرجة
مع الانتباه لضرورة حذف قيمة F20 في النموذج لأنها موجودة ضمن الراتب الخام L19
مع ملاحظة أن الخلية C19 دخلت في الحسابات مرتين في منحة التأهيل ومنحة الدعم مرة قبل الدرجة ومرة بعد الدرجة
بالتوفيق
 
vba 2023 office.xlsm

على فرض ان الخلية المطلوبة a1 أو نطاق معين أوله الخلية A1
نقوم بتحديد النطاق ثم نضغط على data validation من تبويب data
ثم نختار custom
ونكتب هذه المعادلة في التحقق من الصحة
=OR(A1<=4,A1="غ") سيتم التطبيق على جميع خلايا النطاق المحدد
بالتوفيق

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

عليكم السلام ورحمة الله وبركاته
يرجع السبب إلى وجود خلية بنفس الاسم في الامتدادات الحديثة xlsx و xlsm وغيرها
حيث أنه من المعروف أن آخر خلية في اكسل 2003 وما فبله أو الامتداد xls هي IV65536 أما في اكسل 2007 وما بعده هي XFD1,048,576
والحل تغيير اسم الدالة المعرفة بإضافة _ (الشرطة السفلية اندر سكور) إلى نهاية الاسم ليصبح مثلا
Function IRG2008_(soumis) واستعمال الدالة في الخلايا هكذا
=IRG2008_(A1) أو استعمال 4 حروف في اسم الدالة
المهم إيجاد اختلاف بين اسم الخلية واسم الدالة المعرفة 
بالتوفيق

عليكم السلام ورحمة الله وبركاته
على افتراض أن اكبر عدد أصفار هو 5 يمكنك استعمال هذه المعادلة
=E4/IF(MOD(E4,100000)=0,100000,IF(MOD(E4,10000)=0,10000,IF(MOD(E4,1000)=0,1000,IF(MOD(E4,100)=0,100,IF(MOD(E4,10)=0,10,1))))) وإذا زاد العدد عن 5 يمكنك إضافة شرط في بداية المعادلة مع زيادة عدد الأصفار في mod وفي ناتج if إذا تحقق الشرط وزيادة أقواس الإغلاق
وتم مراعاة ألا يكون العدد ينتهي بأصفار على اليمين
بالتوفيق

عليكم السلام ورحمة الله وبركاته
يمكنك استعمال معادلة الاستبدال التالية
=SUBSTITUTE(B2,CHAR(10)," ") بالتوفيق

عليكم السلام ورحمة الله وبركاته
جرب استعمال هذه المعادلة في الخلية I2
=DATE(YEAR(H2)-L2,MONTH(H2)-K2,DAY(H2)-J2+1)  
كما تم تعديل معادلات الفرق بين تاريخين في المرفق
بالتوفيق
استخراج تاريخ التعين.xlsx

يمكنك استعمال هذه المعادلة في الخلية B3
=INDIRECT("'"&A3&"'!B2") تم استعمال الفاصلة المفردة بحيث إذا كان اسم الشيت يحتوي على مسافة
وإذا لم يكن يحتوي على مسافة فيمكن اختصار المعادلة 
=INDIRECT(A3&"!B2") مع سحب المعادلة لأسفل
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية C3
=IF(RIGHT(D3,8)="المحترمة",": الدكتورة المحاضرة",": الطبيب المحاضر") وتعديل هذا الكود في خدث قبل الدبل كلك
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("g10:j15")) Is Nothing Then Application.Calculation = xlManual Application.ScreenUpdating = False Application.EnableEvents = False ActiveSheet.Unprotect Password:="123" Target.Value = "Negative" ActiveSheet.Protect Password:="123", DrawingObjects:=True, Contents:=True, Scenarios:= _ False, AllowFormattingCells:=True, AllowFormattingColumns:=True, _ AllowFormattingRows:=False, AllowInsertingColumns:=True, AllowInsertingRows _ :=True, AllowInsertingHyperlinks:=True Application.Calculation = xlAutomatic Application.EnableEvents = True Application.ScreenUpdating = True End If End Sub بالتوفيق

عليكم السلام ورحمة الله وبركاته
 
بالنسبة لدالة xlookup
إن شاء الله يفيدك هذا الموضوع
وبالنسبة لدالة ifs فلا أعتقد أنه تم إيجاد بديل لها غير دوال if المتداخلة
بالتوفيق

يمكنك استعمال هذه المعادلة في K7 لطرح الأسهم
=IF(C7<G7,24,0)+C7-G7 وهذه في L7 لطرح القراريط
=IF(C7<G7,-1,0)+IF(D7<H7,24,0)+D7-H7 وهذه في M7 لطرح الأفدنة
=IF(D7*24+C7<H7*24+G7,-1,0)+E7-I7 مع سحب المعادلات لأسفل
بالتوفيق

أعتقد أنك تريد التقريب لأعلى نصف أو واحد صحيح
وليس لأقرب نصف أو واحد صحيح
على العموم
لأقرب نصف نستعمل هذه المعادلة في اللغة العربية مثلا في الخلية M6
=MROUND((L6/2)*M$4/100,0.5) وهي تقوم بتقريب اقل من 0.25 إلى 0 وتقريبا من 0.25 حتى 0.74 إلى 0.5 وأكثر من 0.75 إلى الواحد الصحيح 
وهي تعمل على إكسل 2007 وما بعده ولمن يستخدم إكسل 2003 يمكن استعمال هذه الدالة المعرقة masround
Function masround(n As Double, m As Double) As Double masround = IIf(n - m * (n \ m) >= m / 2, m * (n \ m + 1), m * (n \ m)) End Function والتقريب لأعلى نصف نستعمل هذه المعادلة
=CEILING((L6/2)*M$4/100,0.5) وهذه المعادلة تقوم بتقريب اقل من 0.5 إلى 0.5 وأكبر من 0.5 إلى واحد صحيح
 
ويمكن نسخ المعادلة في جميع أعمدة الدرجة الأصلية وسحبها لأسفل
مع مراعاة الفاصلة او الفاصلة المنقوطة في المعادلات 
بالتوفيق

بعد إذن حبيبنا أستاذ علي محمد علي
يمكن اختصار المعادلة إلى هذه في الخلية C1
=IF(B1>=90,1,IF(B1>=70,2,IF(B1>=50,3,IF(B1>=40,4,IF(B1>=1,5,6))))) بالتوفيق

عليكم السلام ورحمة الله وبركاته
إن شاء الله تفيدك هذه المعادلات البسيطة
Large
Small
index & match
بالتوفيق
أعلى وأقل الأيام حضورا.xlsx

عليكم السلام ورحمة الله وبركاته
إذا كان الهدف هو مجرد ترتيب بالمعادلات
قيمكنك استعمال هذه المعادلة في الخلية F4 للحصول على نفس المجموعة مرتبة
=INDEX($A$4:$C$11,MATCH(ROW()-3,$A$4:$A$11,0),COLUMN()-5) مع ملاحظة بداية ونهاية نطاق البحث A4:C11
وعدد الصفوف الفارغة قبل مكان أول نتيجة (F4) == 3
وخلايا الفهرس غير المرتب الذي يتم التريب عليه A4:A11
وعدد الأعمدة الفارغة قبل مكان أول نتيجة == 5
مع سجب المعادلة لأسفل ولليمين
بالتوفيق

جرب استعمال هذه المعادلة في الخلية G6
=IF(B6="","",IF(DATEDIF(D6,E6,"md")>=30,IF(DATEDIF(D6,E6,"ym")+1=12,0,DATEDIF(D6,E6,"ym")+1),DATEDIF(D6,E6,"ym"))) وهذه في الخلية F6
=IF(B6="","",IF(DATEDIF(D6,E6,"ym")+1=12,1,0))+DATEDIF(D6,E6,"y") بالتوفيق

الكود السابق يملأ الخلايا الفارغة كلها بدون شروط
لذا يلزم إضافة شرط
يمكنك استعمال هذا الاجراء
تم إضافة شرط أن تكون خلية العمود B في نفس الصف غير فارغة
Sub masFillBlanks() Dim rng As Range For Each rng In Range("H11:AT75") If Range("b" & rng.Row) <> "" And IsEmpty(rng) Then rng.Value = "-" Next MsgBox "Done by mr-mas.com" End Sub وهذا نفس الاجراء بطريقة أخرى
Sub masFillBlanks2() Dim arr, r As Long, c As Long arr = Range("H11:AT75").Value For r = LBound(arr, 1) To UBound(arr, 1) If Range("b" & r + 10) <> "" Then For c = LBound(arr, 2) To UBound(arr, 2) If IsEmpty(arr(r, c)) Then Cells(r + 10, c + 7) = "-" Next c End If Next r MsgBox "Done by mr-mas.com" End Sub وأنصح بعدم وجود صفوف أو أعمدة زيادة مثل ما بعد الصف 47 وlما بعد العمود AN
بالتوفيق

المنتدى به كنوز رائعة
تحتاج فقط من يبحث عنها
https://www.officena.net/ib/search/?q=صورة الموظف&quick=1&type=forums_topic&nodes=135&search_and_or=and
بالتوفيق

أخي الكريم صاحب الموضوع
اول خطوة لتعديل الكود فهمه وفهم متغيراته 
والكود القديم يقوم بنقل قيمة العمود J إلى العمود 19 بعد العمود الأول في شيت البيانات
والمطلوب إضافة نفس الكود عند تعديل العمود G ويتم نقله إلى العمود 16 بعد العمود الأول في شيت البيانات
لذلك يصبح الكود بعد التعديل
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Set ws = Sheets("البيانات") Dim c, x Application.ScreenUpdating = False If Not Intersect(Target, Range("g8:g1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) ws.Cells(x, 1).Offset(, 16) = Target Ebd If If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) ws.Cells(x, 1).Offset(, 19) = Target End If Application.ScreenUpdating = True End Sub لاحظ تم تكرار سطور الشرط للعمودين g و j مع تغيير رقم العمود المرحل إليه مرة 19 ومرة 16
بالتوفيق

أخي الكريم صاحب الموضوع
اول خطوة لتعديل الكود فهمه وفهم متغيراته 
والكود القديم يقوم بنقل قيمة العمود J إلى العمود 19 بعد العمود الأول في شيت البيانات
والمطلوب إضافة نفس الكود عند تعديل العمود G ويتم نقله إلى العمود 16 بعد العمود الأول في شيت البيانات
لذلك يصبح الكود بعد التعديل
Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim ws As Worksheet Set ws = Sheets("البيانات") Dim c, x Application.ScreenUpdating = False If Not Intersect(Target, Range("g8:g1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) ws.Cells(x, 1).Offset(, 16) = Target Ebd If If Not Intersect(Target, Range("j8:j1000")) Is Nothing Then c = Target.Offset(, -9) x = Application.Match(c, ws.Columns(1), 0) ws.Cells(x, 1).Offset(, 19) = Target End If Application.ScreenUpdating = True End Sub لاحظ تم تكرار سطور الشرط للعمودين g و j مع تغيير رقم العمود المرحل إليه مرة 19 ومرة 16
بالتوفيق

يفترض أنه تم حل شيء شبيه بهذا لك قبل ذلك
فأين محاولتك والتي تدل على الاستفادة مما سبق تعلمه؟

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

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