Ali Mohamed Ali

بارك الله فيك استاذ شريف ولإثراء الموضوع هذا كود اخر: Sub Delete_Rows() Dim cell As Range Dim delRange As Range Application.ScreenUpdating = False For Each cell In ThisWorkbook.Sheets(2).Range("A2:G" & Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row) If cell.DisplayFormat.Interior.ColorIndex = 3 Then If delRange Is Nothing Then Set delRange = cell Else Set delRange = Union(delRange, cell) End If Next cell If Not delRange Is Nothing Then delRange.EntireRow.Delete Application.ScreenUpdating = True End Sub

تفضل اخى الكريم لك ما طلبت الفرق بين الجدولين.xlsm

تفضل أخى الكريم تحليل النتائج.xls

أهلا وسهلا بك أخ كريم فى منتدانا بين اخوانك تفضل هذا الملف به ما طلبت Book1.xlsx

وعليكم السلام -لو ممكن ارسال الملف للعمل عليه يكون هذا افضل وتوضيح المطلوب عليه

اخى الكريم لتقليل حجم الملف قم بحفظ الملف بصيغة Binary وحاول تقليل المعادلات المستخدمة بعض الشئ والاستعاضة عنها بالاكواد مثلا حيث ان هناك بعض المعادلات تجعل الملف ثقيلا مثلا مثل sumif ، sumproduct وايضا يجب عليك تقليل التنسيقات المبالغ فيها مثلا ان وجد صور او خلفيات .... وخلافه بارك الله فيك

ذلك امر طبيعى لكثرة المعادلات

بارك الله فيك استاذ سليم وجزاك الله كل خير وهذا حل اخر لإثراء الموضوع data.xlsx

تفضل اخى الكريم Document.xlsx

ادخل أولا على لوحة التحكم-Control Panel ثم اتبع الخطوات بالصور :

أخى الكريم لا يصلح بالمعادلات اليك الكود تكتب اسم الشيت الذى تريده فى الخلية A1 ولكن المعادلات فقط لإيجاد واستخلاص اسم الشيت وكتابته فى خلية ما وليس العكس بارك الله فيك Private Sub Worksheet_Change(ByVal Target As Excel.Range) If Target.Address = "$A$1" Then ActiveSheet.Name = Target.Text End Sub

مشكلتك انك مقيد المعادلة فى صف واحد وهذه معادلة مصفوفة فبمجرد سحب المعادلة الى الأسفل فتحل المشكلة مهما زادت عدد الصفوف ولكن فى حالتك سوف تزود هذا الجزء من المعادلة &"و "&IFERROR(INDEX($B$8:$B$1000,SMALL(IF($F$8:$F$1000=$N$1,ROW($B$8:$B$1000)-ROW($B$8)+1),ROWS($O$3:O6))),"")

تفضل اخى الكريم عرض الاسماء في كل نطاق2.xlsx

وعليكم السلام تفضل اخى الكريم عرض الاسماء في كل نطاق.xlsx

تفضل اخى الكريم مواعيد المشاريع.xlsx

من فضلك اكمل البيانات كى نستطيع عمل ما تريد فملف الإكسيل فارغ لا يوجد فيه بيانات لعمل المطلوب بارك الله فيك

أول صفحة فى الملف بالمعادلات

وهو كذلك بالملف المرسل اليك فيه هذا الطلب

بسبب تاخرك فى الرد فقد تم حذفه اليك الشيت مرة اخرى-برجاء الإهتمام والرد تغيير اسم الخلية مع اسم الورقة.xlsm

لو ممكن ترسل الملف لمساعدتك

يمكنك تتبع هذا : https://support.office.com/ar-sa/article/استخدام-بيانات-ورقة-العمل-في-onedrive-c051a205-1c06-4feb-94d8-793b0126b53a وتتبع هذا الفيديو http://godialy.com/video/73_YJEg3FtU

ممكن استخدام هذا الكود فى حدث الصفحة Option Explicit Const WelcomePage = "Macros" Private Sub Workbook_BeforeClose(Cancel As Boolean) 'Turn off events to prevent unwanted loops Application.EnableEvents = False 'Evaluate if workbook is saved and emulate default propmts With ThisWorkbook If Not .Saved Then Select Case MsgBox("Do you want to save the changes you made to '" & .Name & "'?", _ vbYesNoCancel + vbExclamation) Case Is = vbYes 'Call customized save routine Call CustomSave Case Is = vbNo 'Do not save Case Is = vbCancel 'Set up procedure to cancel close Cancel = True End Select End If 'If Cancel was clicked, turn events back on and cancel close, 'otherwise close the workbook without saving further changes If Not Cancel = True Then .Saved = True Application.EnableEvents = True .Close savechanges:=False Else Application.EnableEvents = True End If End With End Sub

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

هذا الملف به الأكواد وهذه ايضا صورتين للتوضيح لكيفية وضع الأكواد فى الملف التاريخ والوقت.xlsm

أهلا وسهلا بك فى منتدانا الكريم من الأفضل ارسال الملف للعمل عليه ولكن يمكنك وضع هذه المعادلة فى الخلية التى تريدها لإعطاء الوقت والتاريخ الحاليين =TEXT(TODAY(),"d/m/yyy")&" "&TEXT(NOW(),"hh:mm:ss") وهناك ايضا هذا الكود لجعل الوقت يعمل وشغال بأستمرار Sub Date_Time() On Error Resume Next 1 DoEvents N = Now Range("c13") = Format(N, "[$-F400]h:mm:ss AM/PM") T = T + 1 For r = 1 To 10000000: Next r GoTo 1 End Sub وهذا كود اخر يمكنك اضافته فى حدث الورقة بحيث اذا قمت بتسجيل اى شيء فى العمود B سيضهر لك التاريخ فى العمود C والوقت فى العمود D Private Sub Worksheet_Change(ByVal Target As Range) n = Now If Target.Column = 2 Then If Target = "" Then Cells(Target.Row, Target.Column + 1) = "" Cells(Target.Row, Target.Column + 2) = "" Exit Sub ElseIf Target <> "" Then Cells(Target.Row, Target.Column + 1) = Date Cells(Target.Row, Target.Column + 2) = Time End If End If End Sub بارك الله فيك