سليم حاصبيا

ارفع ملفاً عما تريد يحتوي على الموجود في الصفحة الاولى مع بيانات عشوائية(ليس خلايا فارغة) و النتيجة التي تتوقعها في صفحة ثانية

اولاً: لم افهم ماذا تريد ان تفعل انت قنت بتحديد نطلق معين ثم عملت له Copy ثانياً: لنسخ الكود ز ليظهر بشكل صحيح اتبع الصورة

ربما كان هذا المطلوب Salim2.xlsm

جرب هذا الملف Salim1.xlsm

ممكن ان يكون الحل Book_salim_AB_Sharaf.xlsm

جرب هذا الملف salim كشف.xlsx

اذا كان معنا نص معين و نريد ان نعرف الكلمة رقم 2 او 5 أو ....... فيه كيف تفعل ذلك لا تيأس اكسل يحل لك هذه المشكلة N_th word.xlsm

لعله المطلوب المصنف salim.xlsm

احذف اشارة "=" ( 0.5 =>)من داخل المعادلة الاولى و اضفها في المعادلة الثانية ( 0.5 =< ) و تحصل على ما تريد يا سيدي احملها من المعادلة الاولى وارمها في الثانية المعادلة الاولى تصبح =CHOOSE((MOD(SUM($F7:$I7)/$J$3,1)<0.5)+1,QUOTIENT(SUM($F7:$I7),$J$3)+1,QUOTIENT(SUM($F7:$I7),$J$3)) المعادلة الثانية تصبح =QUOTIENT(SUM($F7:$I7),$J$3)+(MOD(SUM($F7:$I7)/$J$3,1)>=0.5)

يمكن هذه أقصر قليلاً =QUOTIENT(SUM($F7:$I7),$J$3)+(MOD(SUM($F7:$I7)/$J$3,1)>0.5)

ربما هذه المعادلة تقوم بالواجب =CHOOSE((MOD(SUM($F7:$I7)/$J$3,1)<=0.5)+1,QUOTIENT(SUM($F7:$I7),$J$3)+1,QUOTIENT(SUM($F7:$I7),$J$3))

هناك احتمالان ولا اعرف ايهما تريد (لأن السؤال غير واضح) لذلك وضعت لك الاحتمالين (اختر ما تريد) Salimالجمع بشرط.xlsx

جرب هذا الملف الماكرو الاول يغطيك البينات حسب الشهر الماكرو الثاني يغطيك البينات حسب اول عامود فارغ انا اخترت الاول للزر يمكنك التغيير الى الثاني اذا اردت Option Explicit Sub My_DATA() Dim MY_RG As Range Dim X% Sheets("صفحة 2").Select X = Evaluate("=MATCH(صفحة1!$C$1,'صفحة 2'!$A$3:$M$3,0)") Set MY_RG = Sheets("صفحة 2").Range(Cells(4, X), Cells(500, X)) MY_RG.Formula = "=IF(B4="""","""",INDEX(صفحة1!$C$3:$C$500,MATCH($B4,صفحة1!$B$3:$B$500,0)))" MY_RG.Value = MY_RG.Value End Sub Rem ================================================ Sub My_match() Dim MY_RG As Range Dim X% X = Evaluate("=MATCH(TRUE,(A4:Z4)="""",0)") Sheets("صفحة 2").Select Set MY_RG = Sheets("صفحة 2").Range(Cells(4, X), Cells(500, X)) MY_RG.Formula = "=IF(B4="""","""",INDEX(صفحة1!$C$3:$C$500,MATCH($B4,صفحة1!$B$3:$B$500,0)))" MY_RG.Value = MY_RG.Value End Sub الملف مرفق الاستحقاق الشهرى SALIM.xlsm

جرب هذا الماكرو الاول لاخفاء ما تريد الثاني لاظهار الكل Option Explicit Rem First Macro Sub show_hide_col() Range("f6:Au6").Columns.Hidden = True Dim x%: x = Evaluate("MATCH(D2,$F$6:$AU$6,0)") + 5 Dim y%: y = Evaluate("MATCH(D3,$F$6:$AU$6,0)") + 5 Range(Cells(1, x), Cells(1, y)).EntireColumn.Hidden = False End Sub '=============================== Rem Seconde Macro Sub show_all() Range("f6:Au6").Columns.Hidden = False End Sub

تم التعديل قليلاً على الملف لتصغير حجمه و تعديل المعادلات (بدون هذه IF المشروطة) بالنسبة لتسلسل المواسم كل شيء يظهر اوتو ماتيكياً Salim_ages_New.xlsx

هذه المغادلة في و اسحب نزولاُ =IF(A2="","",LEFT(SUBSTITUTE(A2," ","*",3),FIND("*",SUBSTITUTE(A2," ","*",3))-1)) تبقى بغض المشاكل في الاسماء المركبة (عبدالله أو سيف النصر مثلاً) التي بحب كتابتها يدوياً أو ازالة الفراغ بين الاسم الاول و الاسم الثاني في التركيب مثلا عبد الله تكتب عبدالله

كما تريد ارجع المغادلة كما كانت في 3 (لفك الحماية عن الشيت والكتابة في الخلايا المحمية اضغط ALT+R+P+S) ثم Enter بالنسبة للتاريخ جرب تغيير التاريح في الجهاز الى اى سنة و سترى كبف تعمل المعادلات في العامود J

ممكن الحل هنا Aziz_salim.xlsx

حرب الان Salim_ages.xlsx

ارفع الملف للمعالجة

تم معالجة الامر بالنسبة للصفحة Print بالنسبة لبقية الصفحات سوف يعمل الكود اذا تم جذف هذا السطر منه (بوضع كلمة Rem) امامه وتغيير اسم الكود (حتى لا يختلط الكودين مع بعض) If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out ملاحظة (لا نتس وصع الرقم المناسب في الخلية N1) ليصبح هكذا مثلاً Sub InsertPageBreaks_with_choosen_row_for_All() Rem If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out If Not IsNumeric(Range("N1")) Or Range("N1") < 5 Then GoTo Leave_Me_Out Range("N1") = Int(Range("N1")) Application.ScreenUpdating = False Dim Xrow% Dim i% Dim xLastrow As Long Dim x% Dim xWs As Worksheet Set xWs = Application.ActiveSheet xWs.PageSetup.PrintTitleRows = "$10:$11" xWs.PageSetup.FitToPagesWide = 1 Xrow = Range("N1") 'Xrow = Application.InputBox("How Many Rows in page?", "Salim tell you", Type:=1) xWs.ResetAllPageBreaks xLastrow = Cells(Rows.Count, 2).End(3).Row + 4 For i = Xrow + 12 To xLastrow Step Xrow xWs.HPageBreaks.Add Before:=xWs.Cells(i, 1) x = xLastrow - i If x < Xrow Then xWs.HPageBreaks.Add Before:=xWs.Cells(i + x + 1, 1) Exit For End If Next xWs.PageSetup.FitToPagesWide = 1 Leave_Me_Out: Application.ScreenUpdating = True End Sub K G_Salim.xls

جرب هذا الملف (من دون يوزر) لاني لا احب التعامل مع اليوزر فورم الكود Sub InsertPageBreaks_with_choosen_row() If ActiveSheet.Name <> "Print" Then GoTo Leave_Me_Out If Not IsNumeric(Range("N1")) Or Range("N1") < 5 Then GoTo Leave_Me_Out Range("N1") = Int(Range("N1")) Application.ScreenUpdating = False Dim Xrow% Dim i% Dim xLastrow As Long Dim x% Dim xWs As Worksheet Set xWs = Application.ActiveSheet xWs.PageSetup.PrintTitleRows = "$10:$11" xWs.PageSetup.FitToPagesWide = 1 Xrow = Range("N1") 'Xrow = Application.InputBox("How Many Rows in page?", "Salim tell you", Type:=1) xWs.ResetAllPageBreaks xLastrow = Cells(Rows.Count, 2).End(3).Row + 4 For i = Xrow + 12 To xLastrow Step Xrow xWs.HPageBreaks.Add Before:=xWs.Cells(i, 1) x = xLastrow - i If x < Xrow Then xWs.HPageBreaks.Add Before:=xWs.Cells(i + x + 1, 1) Exit For End If Next Leave_Me_Out: Application.ScreenUpdating = True End Sub الملف مرفق Variable Print Area.xls

كل شيء ممكن My_Trunc.xlsm

او هذا الملف TEKRAR1.xlsx

جرب هذا الملف transfer_salim.xlsx