فهد بن احمد قام بنشر ديسمبر 18, 2024 قام بنشر ديسمبر 18, 2024 السلام عليكم الاخوة الزملاء ارجو مساعدتي ولكم خالص الشكر مرفق مثال للملف يكون كود او معادلة او تنسيق شرطي بحيث اذا تكررت المهنة مثلا 5 او 7 مرات إجازة يكون فيه تنبيه اني تجاوزت الحد لهذا الشهر وعامود تاريخ الاستلام يكون عند ادخال كود الموظف ينزل تاريخ اليوم نفسة ولا يتغير في اليوم الثاني اجاز.xlsxFetching info...
عبدالله بشير عبدالله قام بنشر ديسمبر 18, 2024 قام بنشر ديسمبر 18, 2024 (معدل) وعليكم السلام ورحمة الله وبركانه الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Me.Range("B:B")) Is Nothing Then Dim c As Range For Each c In Target If c.Value <> "" And IsEmpty(c.Offset(0, 1).Value) Then c.Offset(0, 1).Value = Date End If Next c End If If Not Intersect(Target, Me.Range("D:D")) Is Nothing Then Dim dCell As Range For Each dCell In Target If dCell.Offset(0, 2).Value = "إجازة" Then If Application.WorksheetFunction.CountIfs(Me.Range("D:D"), dCell.Value, Me.Range("F:F"), "إجازة", _ Me.Range("E:E"), ">=" & DateSerial(Year(dCell.Offset(0, -1).Value), Month(dCell.Offset(0, -1).Value), 1), _ Me.Range("E:E"), "<=" & WorksheetFunction.EoMonth(dCell.Offset(0, -1).Value, 0)) > 5 Then dCell.Interior.Color = RGB(255, 0, 0) Else dCell.Interior.ColorIndex = -4142 End If Else dCell.Interior.ColorIndex = -4142 End If Next dCell End If Application.EnableEvents = True End Sub الملف اجاز.xlsbFetching info... تم تعديل ديسمبر 18, 2024 بواسطه عبدالله بشير عبدالله 2
محمد هشام. قام بنشر ديسمبر 18, 2024 قام بنشر ديسمبر 18, 2024 (معدل) وعليكم السلام ورحمة الله تعالى وبركاته بعد إذن الأستاد @عبدالله بشير عبدالله بما ان الكود الخاص به يعتمد على التنسيق إليك حل آخر باظهار رسالة تنبيه عند تجاوز الحد الاقصى للتكرارات بشرط التاريخ في عمود b [نفس الشهر ] واسم المهنة عمود d والحالة في عمود F طريقة الإدخال الكود_ المهنة _الحالة Private Sub Worksheet_Change(ByVal Target As Range) Dim lastRow As Long, Max As Integer, kay As Variant, xdate As Variant Max = 5 Application.EnableEvents = False lastRow = Cells(Rows.Count, 4).End(xlUp).Row If Not Intersect(Target, Me.Columns("B")) Is Nothing Then For Each cell In Target If cell.Value <> "" And IsEmpty(cell.Offset(0, 1).Value) Then cell.Offset(0, 1).Value = Date Else cell.Offset(0, 1).Value = "" End If Next cell End If If Not Intersect(Target, Me.Range("C5:F" & lastRow)) Is Nothing Then For Each cell In Target If cell.Column = 6 And cell.Value = "إجازة" Then kay = cell.Offset(0, -2).Value xdate = cell.Offset(0, -3).Value If IsEmpty(kay) Or IsEmpty(xdate) Then MsgBox "يجب إدخال كود الموظف", vbExclamation, "إنتبـــــاه" cell.ClearContents GoTo SupAPP End If If WorksheetFunction.CountIfs(Range("D5:D" & _ lastRow), kay, Range("F5:F" & lastRow), "إجازة", Range("C5:C" & lastRow), xdate) > 1 Then cell.ClearContents MsgBox " تم الوصول للحد الأقصى للإجازات هدا الشهر لسائقين :" & _ " " & kay, vbExclamation, "إنتبـــــاه" GoTo SupAPP End If If WorksheetFunction.CountIfs(Range("D5:D" & _ lastRow), kay, Range("F5:F" & lastRow), "إجازة", Range("C5:C" & lastRow), ">=" & WorksheetFunction.EoMonth(xdate, -1) + 1, _ Range("C5:C" & lastRow), "<=" & WorksheetFunction.EoMonth(xdate, 0)) > Max Then cell.ClearContents MsgBox "وصلت للحد الأقصى لهذا الشهر في إجازات السائق: " & kay, vbExclamation, "إنتبـــــاه" End If End If SupAPP: Next cell End If Application.EnableEvents = True End Sub اجاز V1.xlsbFetching info... تم تعديل ديسمبر 18, 2024 بواسطه محمد هشام. 3
فهد بن احمد قام بنشر يناير 1 الكاتب قام بنشر يناير 1 شكراً لك اخي محمد حاولت ارتب الملف الي عندي للأسف لم تزبط معي مرفق لك الملف ليتمكن الجميع من الاستفادة منه وأريد طلبين في داخل الملف موجودة أتمنى تلبية طلبي منكم الاول فيما يخص التنبية بشرط الثاني احتساب الاستحقاق للاجازة حسب الجنسية خطة اجازات الحركة.rarFetching info...
فهد بن احمد قام بنشر الإثنين at 18:15 الكاتب قام بنشر الإثنين at 18:15 للرفع اذا فيه استطاعه من الاخوه
AbuuAhmed قام بنشر الإثنين at 20:42 قام بنشر الإثنين at 20:42 هل نتائج مجموع الإجازات سليمة؟ *بدون أكواد* Vacations_04.xlsxFetching info...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.