أ / محمد صالح

المعادلة صحيحة مائة بالمائة
لأن شهر أغسطس 31 يوما
فلذلك لم يتم الشهر الثاني عشر حتى يكون الناتج 1 سنة 
وأي تعديل في المعادلة بإضافة يوم أو طرح يوم سيجعل ناتج المعادلة في غير هذه الحالات غير صحيح
ربما تحتاج لحساب الفرق بين تاريخين على اعتبار أن الشهر 30 يوما فقط بدون الاهتمام بعدد ايام الشهر الحالي سواء 28 أو 29 أو 31
وهذا موجود في المنتدى
يمكنك البحث عنه
وهذه أحد النتائج
بالتوفيق

الموضوع بسيط جدا
أحدث تاريخ يمكنك استعمال دالة max للخلايا التي بها تواريخ مثلا
=max(b2,d2,f2,.......) وهكذا آخر عمود فيه تاريخ
وبالنسبة لإجمالي القيم يمكنك استعمال دالة sum للخلايا التي بها قيم مثلا
=sum(a2,c2,e2,.......) بالتوفيق

الكود في الملف مكتوب لنواة ويندوز مختلفة مثلا 32بت والنسخة الحالية 64بت
وإذا كان لك صلاحية الدخول على الكود يمكنك وضع كلمة ptrsafe قبل اسم الدالة أو الإجراء مثل هذا الكود
#If VBA7 Then Private Declare PtrSafe Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr #Else Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long #End If بالتوفيق

يمكنك عمل ذلك من خلال التنسيق الشرطي عن طريق معادلة
=OR(C$6="الجمعة",C$6="السبت") وتطبق على الخلايا  C7:AH56
بالتوفيق

يمكنك استعمال هذه المعادلة في الخلية D6
=IFERROR(INDEX(الاسماء!$G$6:$G$215,MATCH(الخطة!D6,الاسماء!$F$6:$F$215,0)),"") ثم سحب المعادلة للأسفل ويسارا
وإذا كنت تستعمل النسخ الحديثة للأوفيس يمكنك استعمال هذه المعادلة بدون سحب في الخلية D6 فقط'
=IFERROR(INDEX(الاسماء!$G$6:$G$215,MATCH(الخطة!D6:AD230,الاسماء!$F$6:$F$215,0)),"") بالتوفيق

هذا يعتمد على طريقة بنائك لعناصر القائمة ليست بوكس
أثناء إضافة العناصر إليها يمكنك التحكم في تنسيق القيم الموجودة في الخلايا مثلا بهذه الصورة
Dim i As Integer For i = 1 To 10 ListBox1.AddItem Format(Cells(i, 1).Value, "0.00") Next i هذا الكود يقوم بإضافة الخلايا من A1:A10 إلى القائمة وتنسيق الرقم بها إلى رقمين عشريين
بالتوفيق

ما شاء الله أنت وصلت لمستوى جميل
لماذا تقول أنك مبتدئ؟
أقترح عليك الاعتماد على العمود F في تحديد القائمة
يمكنك تجربة هذا التعديل
Sub WhatsApp() Dim Contact As String Dim Message As String Dim Obj As New DataObject Dim lr As Long lr = Cells(Rows.Count, "F").End(xlUp).Row For Each Cell In Range("F2:f" & lr) Contact = Cell.Value Message = Cell.Offset(0, 2).Value Obj.SetText Message Obj.PutInClipboard ActiveWorkbook.FollowHyperlink "https://wa.me/" & Contact Application.Wait(Now + TimeValue("00:00:06")).True Call SendKeys("^v", True) Application.Wait(Now + TimeValue("00:00:05")).True Call SendKeys("~", True) Application.Wait(Now + TimeValue("00:00:05")).True Next MsgBox "Done!" End Sub بالتوفيق

عليكم السلام ورحمة الله وبركاته
يمكنك تجربة هذا الكود
Sub TransferData() Dim wsCurrent As Worksheet Dim wsPrevious As Worksheet Dim lastRow As Long Dim i As Long Dim j As Long Dim targetRow As Long ' تحديد الشيت الحالي والشيت السابق Set wsCurrent = ThisWorkbook.Sheets("6") ' قم بتغيير اسم الشيت حسب الحاجة Set wsPrevious = ThisWorkbook.Sheets("5") ' قم بتغيير اسم الشيت حسب الحاجة ' إيجاد آخر صف في الشيت الحالي lastRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row ' مسح الصفوف التي تحتوي على كلمة "منقول" في العمود M For i = lastRow To 7 Step -1 If wsCurrent.Cells(i, "M").Value = "منقول" Then wsCurrent.Rows(i).Delete End If Next i ' إيجاد آخر صف بعد المسح lastRow = wsCurrent.Cells(wsCurrent.Rows.Count, "B").End(xlUp).Row ' ترحيل البيانات من الشيت السابق targetRow = lastRow + 1 For i = 7 To wsPrevious.Cells(wsPrevious.Rows.Count, "B").End(xlUp).Row If wsPrevious.Cells(i, "M").Value = "منقول" Then For j = 1 To 21 ' الأعمدة من A إلى U If j >= 6 And j <= 12 Then wsCurrent.Cells(targetRow, j).Formula = wsPrevious.Cells(i, j).Formula Else wsCurrent.Cells(targetRow, j).Value = wsPrevious.Cells(i, j).Value End If Next j targetRow = targetRow + 1 End If Next i ' ترتيب البيانات حسب الاسم في العمود B wsCurrent.Range("A7:U" & targetRow - 1).Sort Key1:=wsCurrent.Range("B7"), Order1:=xlAscending, Header:=xlNo End Sub بالتوفيق

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

هناك العديد من البدائل لموقع MIT App Inventor التي يمكنك استخدامها لإنشاء تطبيقات الأندرويد بسهولة. إليك بعض الخيارات:
Thunkable: منصة قوية تعتمد على السحب والإفلات لإنشاء التطبيقات. تم تطويرها بواسطة مهندسين من MIT App Inventor1.
AppyBuilder: منصة أخرى تعتمد على السحب والإفلات، مشابهة لـ App Inventor وتوفر ميزات إضافية.
Bubble: أداة لإنشاء تطبيقات الويب بدون برمجة، يمكن استخدامها لإنشاء تطبيقات متقدمة بواجهة مستخدم مخصصة.
بالتوفيق

تفضل أخي الكريم
تم استعمال نفس فكرة اليومي والخصم في نفس يوم تاريخ البداية مع اختلاف الشهور
بالتوفيق
خصم يومي أو شهري تلقائي .xlsx

جرب هذا الكود في أحداث المصنف 
Private Sub Workbook_SheetActivate(ByVal Sh As Object) ShowScrollBar End Sub أو يمكنك وضع كود showscrollbars في هذا الحدث مباشرة بدون تسميته باسم خاص
بالتوفيق

قد تحتاج إلى التأكد من أنك تستخدم أحدث إصدار من Microsoft 365، حيث أن هذه الدالة متاحة في Excel لـ Microsoft 3651.
وإذا كنت مصريا ولك أبناء في التعليم فيمكنك استعمال البريد الموحد الخاص بهم في تفعيل أوفيس 365
بالتوفيق

يمكنك استعمال هذا الكود في النسخ
Private Sub CommandButton19_Click() Dim clipboard As Object Set clipboard = New MSForms.DataObject clipboard.SetText TextBox1.Text clipboard.PutInClipboard End Sub وهذا كود اللصق
Private Sub CommandButton20_Click() Dim clipboard As Object Set clipboard = New MSForms.DataObject clipboard.GetFromClipboard TextBox6.Text = clipboard.GetText End Sub تأكد من أنك قد أضفت مكتبة “Microsoft Forms 2.0 Object Library” إلى مشروعك لتتمكن من استخدام الكائن DataObject.
بالتوفيق

جرب استعمال هذا الكود
For Each cell In range("a2:a10000") cell.Value = "'" & cell.Value Next cell بالتوفيق

وعليكم السلام ورحمة الله وبركاته،
نعم، يمكن القيام بذلك باستخدام VBA في Excel. إليك كود VBA الذي يمكنك استخدامه لتقسيم البيانات إلى ملفات منفصلة كل 30 صف:
افتح ملف Excel واضغط على Alt + F11 لفتح محرر VBA. أدخل الكود التالي في وحدة جديدة:   Sub SplitDataIntoFiles() Dim ws As Worksheet Dim newWs As Worksheet Dim wb As Workbook Dim newWb As Workbook Dim lastRow As Long Dim i As Long Dim j As Long Dim filePath As String Set ws = ThisWorkbook.Sheets("Sheet1") ' تأكد من أن اسم الورقة صحيح lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row filePath = ThisWorkbook.Path & "\" j = 1 For i = 1 To lastRow Step 30 Set newWb = Workbooks.Add Set newWs = newWb.Sheets(1) ws.Rows(i & ":" & i + 29).Copy Destination:=newWs.Rows(1) newWb.SaveAs filePath & "Data_" & j & ".xlsx" newWb.Close SaveChanges:=False j = j + 1 Next i MsgBox "تم تقسيم البيانات بنجاح!",,"mr-mas.com" End Sub قم بتعديل اسم الورقة في السطر Set ws = ThisWorkbook.Sheets("Sheet1") إذا كان مختلفًا. اضغط على F5 لتشغيل الكود. سيقوم هذا الكود بتقسيم البيانات إلى ملفات منفصلة كل 30 صف وحفظها في نفس مسار الملف الأصلي.
بالتوفيق

إجابتي بدون رؤية الملفات؛ لأني على الهاتف حاليا.
المعادلة هي مجرد معادلة بحث عن الرقم الموجود في الخلية m12  وجلب القيم من العمود الثالث في النطاق المسمى prod
للوصول إلى النطاقات المسماة من تبويب معادلات formulas ثم إدارة الأسماء name manager 
بالتوفيق 

يمكنك وضع تاريخ نهاية التقييم في العمود E والتقييم في العمود F
واستعمال هذه المعادلة في العمود C إلى
=IF(TODAY()<=E2,F2,1) بالتوفيق

عليكم السلام ورحمة الله وبركاته
حتى يعمل الكود تلقائيا يجب ربطه بحدث مثل تغيير التحديد أو تغيير محتوى الشيت
وهذا الكود في حدث تغيير محتوى الشيت
Private Sub Worksheet_Change(ByVal Target As Range) Rows("1:16").EntireRow.Hidden = 0 For r = 1 To 16 If Range("b" & r).Value = 0 Then Rows(r & ":" & r).EntireRow.Hidden = True End If Next r End Sub بالتوفيق للجميع

يمكنك الاستفادة من هذه المواضيع
https://www.officena.net/ib/search/?q=سجل غياب&quick=1&type=forums_topic&nodes=135&updated_after=any&sortby=relevancy&search_and_or=and
في تنفيذ برنامجك
وإذا وقفت في نقطة أو اثنتين يمكنك طرحها  في موضوع جديد
مع توضيح المطلوب بمنتهى التفصيل
بالتوفيق

كتابة اسم الشيت بها احتمالات للخطأ
الأفضل اختيار الاسم من قائمة بأسماء الشيتات
ساعتها يمكنك استخدام أمر فتح الشيت
Sheets(Range("a1").Text).Activate بالتوفيق

لعرض آخر 20 ضف يمكنك تغيير هذا السطر في الاجراء showdata
For frw = 4 To last إلى
For frw = last - 19 To last ولخذف الصف المطلوب
Private Sub CommandButton1_Click() If MsgBox("Are you sure you want to delete this item?", vbYesNo, "Confirm Delete") = vbYes Then Rows(ListView1.SelectedItem.ListSubItems(1).Text + 3).EntireRow.Delete showdata End If MsgBox "Done by mr-mas.com" End Sub بالتوفيق

يمكن بطرق كثيرة
اسهلها البحث والاستبدال CTRL+H
ثم تكتب في مربع البحث العملة ومربع الاستبدال يترك فارغا
ثم استبدال الكل replace all
بالتوفيق 
 

إذا كان المطلوب تصدير جميع أوراق العمل الى ملف pdf واحد يمكنك استعمال هذا الكود
Sub exportAllSheetToPdf() Dim sh As Worksheet, savpath As String For Each sh In ActiveWorkbook.Worksheets Worksheets(sh.Name).Select False Next sh savePath = "C:\Users\hp\Downloads\moh-selmy\power Q.pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True Sheets(1).Select MsgBox "Done by mr-mas.com" End Sub وإذا كان المطلوب صفحات محددة يمكن استعمال هذا الكود مع كتابة اسماء الشيتات المطلوب تصديرها في المصفوفة
Sub exportSomeSheetsToPdf() Dim savpath As String ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select savePath = "C:\Users\hp\Downloads\moh-selmy\power Q.pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=savePath, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True MsgBox "Done by mr-mas.com" End Sub بالتوفيق

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