سليم حاصبيا

جرب هذا الملف الكود Option Explicit Sub Ashwaii() Dim my_rg As Range Dim My_min%, My_max%: My_min = [c1]: My_max = [d1] Dim lra%: lra = Cells(Rows.Count, 1).End(3).Row If lra < 2 Then lra = 2 Range("a2:a" & lra).ClearContents Dim Nb%: Nb = My_max - My_min + 1 Range("a2").FormulaArray = "=IF(ROWS($A$1:A1)>$D$1-$C$1+1,"""",LARGE((COUNTIF($A$1:A1,ROW(INDIRECT($C$1&"":""&$D$1)))=0)*ROW(INDIRECT($C$1&"":""&$D$1)),RANDBETWEEN(1,SUM(--(COUNTIF($A$1:A1,ROW(INDIRECT($C$1&"":""&$D$1)))=0)))))" Range("a2").AutoFill Destination:=Range("a2:a" & Nb + 1) Range("a2:a" & Nb + 1).Value = Range("a2:a" & Nb + 1).Value End Sub الملف مرفق Fix_rand.xlsm

ممكن هذا الكود ان يقوم بالواجب Private Sub Worksheet_change(ByVal Target As Range) Application.EnableEvents = False If Target.Row >= 14 And Target.Row <= 25 _ And Target.Column <= 12 And IsNumeric(Target) _ And Target.Cells.Count = 1 Then Select Case Target.Column Mod 3 Case 2 Target = Target * 50 / 1000 Case 0 Target = Target / 100 End Select End If Application.EnableEvents = True End Sub

جرب هذا الملف Book_salim.xls

ممكن هذه ايضاً (RIGHT(A1,9=

ارفع (جزء من الملف حوالي 10 صفخات و ليس كل 400 صفحة) للمعالجة بمكنك مبدئياٌ استعمال هذه المعادلة والسحب نزولاً =INDIRECT("'"&ROWS($A$1:A1)&"'!$B$8")

المطلوب غير واضح (الى اي حد تريد التقريب 0.5 / 3 / 5 / 10) ربما يعطيك فكرة هذا الملف Match salim.xlsx

جرب هذا الملف كارتة الصنف المعدلة salim.xlsx

لحذف اي صف كبسة يمين على رقم الصف تظهر لك قائمة اختر منها حذف(delete) لا انصحك بالحذف أو اضافة اي صفوف (في الورقة Main خصوصاً الصفوف من 1 الى 8 )اذ ربما ذلك أثر سلبًا على عمل الكود (يمكنك مسح محتويات الصف و ذلك بتحديد الخلايا في هذا الصف ثم كبسة Delete لا نتس ان تزيل كلمة OK من العامود GR في نفس الصف لاعادة نسخه الى الورقة المطلوبة اكسل يضيف هذه الكلمة(OK ) في العامود (GR) اوتوماتيكياُ لكل صف تمت عملية نسخة من اجل عدم تكرراها بالنسبة للسؤال الثاني يمكنك فعل ذلك تم تفريغ الجداول بانتظار تعبئة البيانات خطابات الضمان 2018 Salim1.xls

جرب هذا الملف تلوين كلمات.xlsm

تم معالجة الامر المشكلة انك تكتب اسم الشيت بشكل مختلف عن اسمها الحقيقي(تزيد او تنقص مسافات) او تكتب مع الاسم ال التعريف اختر اسم الشيت من القائمة المنسدلة(في العامود B من الصفحة Main ولا تكتبه كتابة(ذلك يضمن ان الاسم مطابق تماماً) تم تغيير اسم الشيت الاول الى Main لحسن عمل الكود اذا اردت ان تعيد نسخ صف ما (اذا ورد فيه اخطاء مثلاً ) مرة ثانية (قم بمسح كلمة "OK" من العامود GR من نفس الصف) الكود Option Explicit Sub copy_data() Dim i%, My_Str$: My_Str$ = "OK" Dim My_SH As Worksheet Dim Source_Sh As Worksheet: Set Source_Sh = Sheets("Main") Dim lr As Long: lr = Source_Sh.Cells(Rows.Count, 2).End(3).Row If lr < 6 Then lr = 6 Dim lr2 As Long For i = 6 To lr If Source_Sh.Cells(i, "GR") <> My_Str Then Set My_SH = Sheets(Source_Sh.Cells(i, 2) & "") lr2 = My_SH.Cells(Rows.Count, 2).End(3).Row + 1 My_SH.Cells(lr2, 2).Resize(1, 19).Value = Source_Sh.Cells(i, 2).Resize(1, 19).Value Source_Sh.Cells(i, "GR") = My_Str End If Next End Sub الملف خطابات الضمان 2018 Salim.xls

جرب المرفق تنقيط تلاميذ Salim .xlsm

يمكن استعمال هذه المعادلة =CHOOSE(((M38*28/100)>100)+1,M38,100)

جرب هذا الملف الكود Option Explicit Sub copy_data() Dim i%, My_Str$: My_Str$ = "OK" Dim My_SH As Worksheet Dim Source_Sh As Worksheet: Set Source_Sh = Sheets("الاجمالى") Dim lr As Long: lr = Source_Sh.Cells(Rows.Count, 2).End(3).Row If lr < 6 Then lr = 6 Dim lr2 As Long For i = 6 To lr If Source_Sh.Cells(i, "GR") <> My_Str Then Set My_SH = Sheets(Source_Sh.Cells(i, 2) & "") lr2 = My_SH.Cells(Rows.Count, 2).End(3).Row + 1 My_SH.Cells(lr2, 2).Resize(1, 19).Value = Source_Sh.Cells(i, 2).Resize(1, 19).Value Source_Sh.Cells(i, "GR") = My_Str End If Next End Sub الملف مرفق خطابات Salim.xls

نظرا لكبر حجم الملف فقد وضعت لك ملفاً مشابهاً يمكنك اقتياس المعادلة منه (المعادلة هي معادلة صفيف اي يلزمها Ctrl_Shift+Enter و ليس Enter وحدها) اللوحات المكررة salim.xlsx

تم معالجة الامر و ذلك باستبدال الرقم 5 بالرقم 6 في هذا السطر last_col = Cells(6, Columns.Count).End(1).Column ريما ينال اعجابك هذا الملف ايضاً Date_without_days_by_colums_and_month2.xlsm

جرب هذا الماكرو (بالنسبة للخدمة تحت 10 سنوات) على ان تتم تكملته فيما يعد Option Explicit Sub calculate_salaire() Dim Complete_Bonus#: Complete_Bonus = [h4] * 5 / 6 Dim sup_Bonus#: sup_Bonus = [h4] * 2 / 3 Dim Sup_Month_Bonus#: Sup_Month_Bonus = [h4] / 18 Dim Sup_day_Bonus#: Sup_day_Bonus = [h4] / 540 Dim s# s = Complete_Bonus + [f6] * Sup_Month_Bonus + sup_Bonus + [g6] * Sup_day_Bonus Range("h6") = s End Sub

اخي علي تلاحظ ان الكود يهذا الشكل الذي وضعته يكرر الصفحات داحل الكومبو مع كل مرة (ولا حاجة لل Array) في هذا الحالة لذلك اقترح لك هذا الكود Private Sub ComboBox1_DropButtonClick() Dim i%, Sh As Worksheet ComboBox1.Clear For Each Sh In Worksheets If Sh.Name <> "TOC" Then _ ComboBox1.AddItem Sh.Name Next End Sub

هذا الجدول مع المعادلة Adel_formula new_final.xlsx

ربما تكون المعادلة المطلوبة =IF($K$6<2,0,$L$2/6*($K$6+$J$6/12+$I$6/360))

بعض التوضيح في هذا الملف Adel_formula new_.xlsx

المعادلة النهائية في الملف Adel_formula new1.xlsx

جرب هذا الملف (صفحة TOC) ADD_Hyper_Link.xlsm

عسى ان يكون هذا المطلوب salim_formula new.xlsx

see this file salim_formula.xlsx

يبدو انك تريد ان تتعامل مع العامود B وليس A كما هو واضح من الصورة لذلك استبدل الرقم 1 يالرقم 2 في هذا السطر من الكود واسم النطاق هكذا Set My_Rg = my_sh.Range("B1:B" & lr) ليصبح الكود بهذا الشكل Sub hid_rows() ' اختر هنا اي ورقة تريد '===================== Dim my_sh As Worksheet: Set my_sh = Sheets("العاملين") 'Dim my_sh As Worksheet: Set my_sh = ActiveSheet '===================== Dim My_Rg As Range Dim lr% lr = my_sh.Cells(Rows.Count, 2).End(3).Row Set My_Rg = my_sh.Range("B7:B" & lr) My_Rg.EntireRow.Hidden = False My_Rg.SpecialCells(4).EntireRow.Hidden = True End Sub