سليم حاصبيا

اكتب هذا المعادلة في الخلية F2 واسحب نزولاً =IFERROR(INDEX(اعتمادية3!$G$2:$G$10,MATCH('تسهيل مهمة'!A2,اعتمادية3!$F$2:$F$10,0)),INDEX(اعتمادية3!$G$2:$G$10,MATCH('تسهيل مهمة'!A2,اعتمادية3!$D$2:$D$10,0)))

اكتب هذه المعادلة في الخلية B1 و اسحب نزولاً اذا لم تعمل معك المعادلة استبدل الفاصلة "," بفاصلة منقوطة ";" =SUBSTITUTE(TRIM(A1),CHAR(32),"")*1 لتصبح هكذا =SUBSTITUTE(TRIM(A1);CHAR(32);"")*1

مرفق الحل اذا لم تعمل معك المعادلة استبدل الفاصلة"," بفاصلة منقوطة";" مجموع حسب التاريخ salim.rar

بمكنك استعمال هذه المعادلة و السحب نزولاً =SUMIFS($C$2:$C$52,$B$2:$B$52,H2)

ربما يكون المطلوب حل معادلة salim.rar

جرب هذا الملف date_difference.rar

ربما هذا الكود هو المطلوب Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column <> 2 Or Target.Count <> 1 Then GoTo 1 Application.EnableEvents = False Range("H:H").ClearContents Target.Offset(0, 6) = 1 1: Application.EnableEvents = True End Sub

جرب هذا الماكرو Private Sub Worksheet_Change(ByVal Target As Range) Dim My_Rg As Range Dim Target_Range As Range Dim My_Val As String Set My_Rg = Union(Range("time_1"), Range("time_2"), Range("time_3")) Set Target_Range = Sheets("sheet2").Range("a1:b30") On Error GoTo 1: If Not Intersect(Target, My_Rg) Is Nothing And Target.Count = 1 _ And IsNumeric(Target) Then Application.EnableEvents = False My_Val = Application.VLookup(Target, Target_Range, 2, 0) Target = My_Val End If 1: Application.EnableEvents = True On Error GoTo 0 End Sub الحل مرفق خطة أسبوعية salim.rar

جرب هذا الملف افسينا salim.rar

عليك بهذه المعادلة =DATE(YEAR($N$1),MONTH($N$1),15)

لا اعلم لماذا طلب نفس الموضوع 6 مرات متتالية تم حذف 5 منها

ارفع جزء من الملف (حوالي 20 سطر)

جرب هذا الكود Option Explicit Sub Create_TOC() Dim wbBook As Workbook Dim wsSheet As Worksheet Dim lnRow As Long Dim lnCount As Long Set wbBook = ActiveWorkbook With Application .DisplayAlerts = False .ScreenUpdating = False End With ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next Sheets("TOC").Select ' TOC (Table Of Contents) If Err.Number = 9 Then Sheets.Add Sheet1: ActiveSheet.Name = "TOC" ActiveSheet.Range("A2:a500").ClearContents On Error GoTo 0 lnRow = 2 lnCount = 1 For Each wsSheet In wbBook.Worksheets If wsSheet.Name <> "TOC" Then With ActiveSheet .Hyperlinks.Add .Cells(lnRow, 1), "", _ SubAddress:="'" & wsSheet.Name & "'!A1", _ TextToDisplay:=wsSheet.Name End With lnRow = lnRow + 1 lnCount = lnCount + 1 End If Next wsSheet With ActiveSheet.Range("a1:d500") .Font.Size = 20 .Font.Bold = True .Columns("A:d").EntireColumn.AutoFit End With With ActiveSheet .Range("a1") = "المحتويات" .Range("c1") = "عدد الصفحات" .Range("d1") = lnCount - 1 End With With Application .ScreenUpdating = True .DisplayAlerts = True End With End Sub الملف مرفق h link salim.rar

تلبية لرغبة الاخ محمد ممتاز تم التعديل على الكود ليظهر الصف الاول عند الطباعة مع الاحتفاظ بعدد الصفوف المطلوبة لكل صفحة طباعة ما عدا اخر صفحة اذا كان عدد الاسطر اقل من المطلوب تظهر البيانات المتبقية مع الاجمالي طباعة أول سطر في كل صفحة مفعلة تستطيع ان تراها من خلال Print Preview (لكن لا يظهر اول سطر على الشاشة العادية) auto_sum advanced.rar

بين الملفات القديمة وجدت هذا الملف عن نفس الموضوع عسى ان ينال اعجابك اخي الزباري auto_sum.rar

يمكن استعمال هذا العبارة التي تأخذ في حسابها زيادة الصفوف For i = rowdiv To lastRow + (lastRow \ rowdiv) * 2 Step rowdiv

For i = rowdiv To lastRow Step rowdiv 'اكتب هنا الكود المناسب Next اخي الزباري لماذا المرور على كل العامود خلية خلية في حين يمكنك استعمال هذه For Netx في الكود ملاحظة اخرى يمكنك استعمال هذا الكود البسيط للتراجع Sub salim_way() On Error Resume Next lastRow = Range("b1").End(xlDown).Row Range("a2:a" & lastRow).SpecialCells(4).EntireRow.Delete Range("c2:c" & lastRow).SpecialCells(xlCellTypeConstants, 2).EntireRow.Delete End Sub ارجو تقبل هذه الملاحظات و ذلك من اجل كود اسرع و متكامل وخدمة للاخرين حيث بمكن ان يكون هناك بيانات كبيرة مما يوفر الوقت

ممكن ان يكون الحل المناسب Sub del_rows_Salim() Application.ScreenUpdating = False lrc1 = Cells(Rows.Count, "c").End(3).Row Range("y7").FormulaArray = "=IFERROR(MATCH(C7&G7,$D$7:$D$30&$G$7:$G$30,0),""A"")" Range("y7").AutoFill Destination:=Range("y7:y" & lrc1) Range("z7").FormulaArray = "=IFERROR(MATCH(D7&G7,$C$7:$C$30&$G$7:$G$30,0),""B"")" Range("z7").AutoFill Destination:=Range("z7:z" & lrc1) For x = lrc1 To 7 Step -1 If Cells(x, "y") = Cells(x, "z") Then Range(Cells(x, 1), Cells(x, 7)).Delete Shift:=xlUp Next Range("y:z").ClearContents Application.ScreenUpdating = True End Sub المرفق test (Autosaved) salim1.rar

جرب هذا الملف صفحة Salim test (Autosaved) salim.rar

في هذه الحالة استعمل هذا الماكرو(اسرع للبيانات الكثيرة) Sub del_rows1() Application.ScreenUpdating = False Application.Calculation = xlCalculationManual lrc = Cells(Rows.Count, "c").End(3).Row: lrd = Cells(Rows.Count, "d").End(3).Row Set rgc = Range("c7:c" & lrc): Set rgd = Range("d7:d" & lrd) For Each celc In rgc For Each celd In rgd If IsEmpty(celc) Then Exit For If celc & " " & celc.Offset(0, 4) = celd & " " & celd.Offset(0, 3) Then rr = celd.Row Range(Cells(rr, 1), Cells(rr, 7)).Delete Shift:=xlUp End If Next Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

بعد اذن اخي زيزو هذا الحل بدون اكود فقط معادلات انظر الى الورقة Salim test1 salim.rar

لنفرض ان الرقم عندك في الخلية A2 اكتب هذه المعادلة =SUBSTITUTE(A2,".","")+0

جرب هذا الماكرو Sub del_rows() lrc = Cells(Rows.Count, "c").End(3).Row: lrd = Cells(Rows.Count, "d").End(3).Row Set rgc = Range("c7:c" & lrc): Set rgd = Range("d7:d" & lrd) For Each celc In rgc For Each celd In rgd If IsEmpty(celc) Then Exit For If celc & " " & celc.Offset(0, 4) = celd & " " & celd.Offset(0, 3) Then rr = celd.Row Range(Cells(rr, 1), Cells(rr, 7)).Delete Shift:=xlUp End If Next Next End Sub

اين الاعجاب او ان النقر على الزر صعبة أوي (انا امزح)

والافضل من ذلك هذا الكود اليسبط Sub Macro1() Range("AZ1:AZ300").SpecialCells(xlCellTypeFormulas, 23).ClearContents End Sub للعمل حسب الماكرو عندك استبدل السطر المذكور بهذا If Cl.HasFormula Then