ادخال الأجازات بكود برمجى

[ياسر أحمد الشيخ]

السلام عليكم ورحمه وبركاته

 

اريد كتابه أجازات كل شخص فى مكانها فى شيت Report ويتم أخذها من شيت Vacc

رمز الأجازة هو "ج"

لقد قمت بكتابه بعض الأجازات يدوياً

أريد عمل ذلك بكود لأن عدد الموظفين كبير جدا وغير مرتبين أبجدياً

ملحوظات:

الرقم 8 يمثل 8ساعات عمل ، و12 يمثل 12 ساعة عمل متواصل

و الرقم "0" يمثل غياب

اريد التأكد أن الأجازة  يتم كتابتها فى الخلايا التى تحتوى على الرقم "0" فقط

لأن من غير المعقول أن يكون الموظف حاضراً ويتم احتسابه أجازة من رصيد الأجازات

وهناك بعض الموظفين تقوم بعمل الأجازة ويحضر إلى العمل لظروف خاصه

وشكرا

انظر المرفق

 

 

Insert Vacc Code_Req.rar

[عبدالله باقشير]

السلام عليكم

جرب الكود التالي

لا يتم كتابة الحرف "ج" الا على الخلايا التي تحتوى على الرقم "0" فقط

وغيرة يتم تلوين الخلية الى الاحمر

Sub kh_tst()
Dim v
Dim Rng As Range
Dim R As Long, m As Long
Dim c As Integer

On Error GoTo 1

With Sheets("Vacc").Range("A2")
    Set Rng = Range(.Cells, .Cells.End(xlDown))
End With

With Sheets("Report")
    For R = 3 To .Cells(Rows.Count, "B").End(xlUp).Row
	    m = Val(CStr(Application.Match(CStr(.Cells(R, "B")), Rng, 0)))
	    If m Then
		    For Each v In Split(Rng.Cells(m, 2), "+")
			    c = Val(v)
			    If c Then
				    With .Cells(R, "B").Offset(0, c)
					    If Val(.Cells) Then .Interior.Color = vbRed Else .Value = "ج"
				    End With
			    End If
		    Next
	    End If
    Next
End With
1
If Err Then MsgBox Err.Number, vbCritical, "Error Number "
Set Rng = Nothing
End Sub

شاهد المرفق 2010

تحياتي

Insert Vacc Code_Req.rar

[الذيب 2015]

ماشاء الله عليك .. استاذي عبدالله باقشير 

 

سلمت أناملك ...  

 

والله ابداع فاق الخيال ...

 

جزيت خيرا

[الذيب 2015]

استاذي عبدالله باقشير

 

هل يعمل

 

الكود اذا ابدلنا الاسماء بأرقام 

[عبدالله باقشير]

استاذي عبدالله باقشير

 

هل يعمل

 

الكود اذا ابدلنا الاسماء بأرقام 

ان شاء الله

جرب واشعرنا بالنتيجة

[الذيب 2015]

السلام عليكم ورحمة الله وبركاته 

 

جربت الملف وأبدلت الاسماء إلى أرقام 

 

ولكن لا يعمل 

 

 

Insert Vacc Code_Req-2.rar

[عبدالله باقشير]

السلام عليكم ورحمة الله وبركاته 

 

جربت الملف وأبدلت الاسماء إلى أرقام 

 

ولكن لا يعمل 

 

 

Insert Vacc Code_Req-2.rar

 

استبدل بهذا

Sub kh_tst()
Dim v
Dim Rng As Range
Dim R As Long, m As Long
Dim c As Integer

On Error GoTo 1

With Sheets("Vacc").Range("A2")
    Set Rng = Range(.Cells, .Cells.End(xlDown))
End With

With Sheets("Report")
    For R = 3 To .Cells(Rows.Count, "B").End(xlUp).Row
        m = Val(CStr(Application.Match(Val(.Cells(R, "B")), Rng, 0)))
        If m Then
            For Each v In Split(Rng.Cells(m, 2), "+")
                c = Val(v)
                If c Then
                    With .Cells(R, "B").Offset(0, c)
                        If Val(.Cells) Then .Interior.Color = vbRed Else .Value = "ج"
                    End With
                End If
            Next
        End If
    Next
End With
1
If Err Then MsgBox Err.Number, vbCritical, "Error Number "
Set Rng = Nothing
End Sub

تحياتي

[الذيب 2015]

اتعبتني عيوني وانا أبحث عن أي أضافة 

 

الى أن وجدت

 

m = Val(CStr(Application.Match(Val(.Cells(R, "B")), Rng, 0)))

 

الله يزيدك علم فوق علمك ... 

 

[الذيب 2015]

استاذ عبدالله باقشير 

 

لو تسمح اريد تعديل الكود ليتناسب مع المطلوب بالمرفق ...

 

ولك جزيل الشكر ...

 

Insert Vacc Code_Req-233.rar

تم تعديل ديسمبر 16, 2014 بواسطه ذيب اليمن

[عبدالله باقشير]

استاذ عبدالله باقشير 

 

لو تسمح اريد تعديل الكود ليتناسب مع المطلوب بالمرفق ...

 

ولك جزيل الشكر ...

 

Insert Vacc Code_Req-233.rar

 

شاهد المرفق 2010

Insert Vacc Code_Req-233.rar

[الذيب 2015]

ماشاء الله عليك ...

 

شهادتي مجروحة فيك ... وفي جميع الاساتذة الموجودين في هذا الصرح العملاق 

 

اشكرك 

 

هذا هو المطلوب ....