سليم حاصبيا

يا أخي تمت الاجابة على هذا السؤال في المشاركة على هذا العنوان https://www.officena.net/ib/topic/88047-اريد-رمز-للراحات-اوتوماتيكيا/?tab=comments#comment-556134

بالنسبة للتكرار هذا الملف Grade1.xlsm

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

لا أعلم اذا كان هذا المطلوب salim أوفيسنا.xlsm

استبدل المعادلة بهذه (السنة في الخلية C2 ) =IF(C7>=DATE($C$2;1;1);1;"")

جرب هذا الملف حضور وغياب -SALIM.xlsx

استبدل الفاصلة بقاصلة منقوطة لتصبح المعادلة هكذا =IF(C8>=43467;1;"")

الكود هو المحمي ولا يمكن الاطلاع عليه لمعاينته على كل حال استعمل هذه المعادلة =IF(C8>=43467,1,"")

لا أعلم اذا كان هذا المطلوب قائمة بشرط.xlsm

كيف تريد ادراج كود في ملف محمي بكلمة س

ممكن بواسطة عامود مساعد _salim تجربة1.xlsm

ربما ينفع هذا الملف Book_s.xlsx

تعديل الماكرو Option Explicit Sub Ashwaii() Application.ScreenUpdating = False With Sheets("Salim") .Select 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 With Sheets("data").Select Application.ScreenUpdating = True End Sub

جرب هذا الملف الكود Option Explicit Sub Tasjil() Dim My_rg As Range Dim i%, x%, r Dim Find_rg As Range Dim Sh1 As Worksheet, Sh2 As Worksheet Set Sh1 = Sheets("sheet1"): Set Sh2 = Sheets("sheet2") Set My_rg = Sh1.Range("a8").CurrentRegion.Columns(1) x = My_rg.Rows.Count For i = 1 To x Set Find_rg = Sh2.Range("a7:I36").Find(My_rg.Cells(i), , , xlWhole) If Not Find_rg Is Nothing Then r = Find_rg.Offset(, 1).Address My_rg.Cells(i).Offset(, 1).Resize(, 2).Value = _ Sh2.Range(r).Resize(, 2).Value End If Next End Sub الملف مرفق _Salimسجل غياب.xlsm

معادلة اخرى =COUNTIF($C$2:$C$6,"?*")

جرب هذا الماكرو Option Explicit Sub Calendar() Dim I As Byte Dim x As Double Dim y As Byte Dim m As Byte: m = 2 Application.ScreenUpdating = False Range("my_rg").ClearContents For I = 1 To 12 x = DateSerial([p2], I, 1) y = Day(Application.EoMonth(x, 0)) Cells(7, m) = x: Cells(7, m).AutoFill Destination:=Range(Cells(7, m), Cells(y + 6, m)), Type:=xlFillDefault m = m + 3 Next Application.ScreenUpdating = True End Sub الملف مرفق My_Calendar.xlsm

جرب هذا الملف الكود Option Explicit Sub Salim_sum() Dim Rg As Range: Set Rg = Range("F2").CurrentRegion Dim X%, Y%, k%, I% Dim My_Num: My_Num = [P2] Dim cont% X = Rg.Rows.Count: Y = Rg.Columns.Count For I = 1 To X Step 3 For k = 2 To Y If Rg.Cells(I, k) = My_Num Then cont = cont + Rg.Cells(I + 1, k) End If Next Next [p3] = cont End Sub الملف مرفق _salim تجربة.xlsm

ارفع مثالا عما تريد

جرب هذا الماكرو Option Explicit Dim arr Sub coloriz_row(My_row) arr = Array("معلم", "معلم اول ا", _ "معلم خبير", "مدير عام", "معلم اول") Cells(My_row, 1).Resize(, 3).Interior.ColorIndex = 3 End Sub '================================ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Row > 2 Then Cells(Target.Row, 1).Resize(, 3).Interior.ColorIndex = 0 End If If Target.Column = 3 And _ Target.Count = 1 And _ Target.Row > 2 And _ IsError(Application.Match(Target.Value, arr, 0)) Then Cells(Target.Row, 1).Resize(, 3).Interior.ColorIndex = 0 coloriz_row (Target.Row) End If Application.EnableEvents = True End Sub

و ما الفائدة من هذا ادرح فوراً التاريخ الثاني وانتهى الامر

من المعروف ان اقرب تاريخ من تاريخ اليوم هو التاريخ الثاتي

تم معالجة الامر في هذا الملف الجديد (يوجد معادلة ايضاً) Option Explicit Option Base 1 Sub random_date() Dim my_date Dim t Dim arr Dim val% arr = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") 1: val = Application.Max([d3], [d5]) - Application.Min([d3], [d5]) my_date = Application.Max([d3], [d5]) - Int(Rnd() * val + 1) t = Weekday(my_date) If t > 5 Then GoTo 1 End If Range("f3") = my_date Range("g3") = arr(t) Erase arr End Sub 103_ salim .xlsm

جرب هذا الماكرو Option Explicit Option Base 1 Sub rand_date() Dim my_date Dim t Dim arr arr = Array("الأحد", "الإثنين", "الثلاثاء", _ "الأربعاء", "الخميس", "الجمعة", "السّبت") 1: my_date = Application.Min([d3], [d5]) - 400 _ + Int(Rnd() * 400) + 1 t = Weekday(my_date) If t > 5 Then GoTo 1 End If Range("f3") = my_date Range("g3") = arr(t) Erase arr End Sub الملف 103_سليم.xlsm

الحل هنا salim_book.xlsx

استبدل هذا السطر Cells(i, 1) = Cells(i, 1) & Chr(46) بهذا (مع كتابة الرقم الصحبج 191) Cells(i, 1) = Cells(i, 1) &" "& Chr(46)