كود ترحيل أيام الغياب مجمعة في خلية واحدة

[ABOU ELSAAD]

الاخوة الكرام 

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

المطلوب المساعدة في  كود يقوم بترحيل ايام الغياب من الكشف الى العمود AL  بحيث تظهر بهذا الشكل في العمودAL بحيث يتم اختيار الخلية التي بها الايام فقط ويترك الخلايا الفارغة

وجزاكم الله خيرا

ترحيل.xlsx

[ابراهيم الحداد]

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

استخدم الكود التالى

Sub AbsCount()
Dim ws As Worksheet, LR As Long
Dim x As Long, y As Integer
Dim C As Range, Abst As String
Const Com = ","
Set ws = Sheets("SS")
x = 3
LR = ws.Range("AG" & Rows.Count).End(xlUp).Row
Do While x <= LR
For Each C In ws.Range("A" & x & ":AE" & x)
If C.Value > 0 Then
Abst = Abst & C.Value & Com
ws.Range("AL" & x) = StrReverse(Left(Abst, Len(Abst) - 1))
End If
Next C
Abst = ""
x = x + 1
Loop


End Sub

 

[ABOU ELSAAD]

جزاك الله خير الجزاء استاذ ايراهيم وجعله في ميزان حسناتك

[أ / محمد صالح]

بعد إذن أخي الكريم @ابراهيم الحداد

لا نحتاج لعكس الكلام لأنه يظهر الأرقام مقلوبة مثل 13 تظهر 31 وهكذا

هذا جهدي المتواضع في هذا المجال

Sub AbsDays()
Dim ws As Worksheet, C As Range, LR As Long, x As Long
Set ws = Sheets("SS")
LR = ws.Range("AG" & Rows.Count).End(xlUp).Row
For x = 3 To LR
ws.Range("AI" & x) = ""
For Each C In ws.Range("A" & x & ":AE" & x)
If C.Value > 0 Then ws.Range("AI" & x) = ws.Range("AI" & x) & IIf(ws.Range("AI" & x) = "", "يوم ", " و") & C.Value
Next C : Next x
MsgBox "Done by mr-mas.com"
End Sub

بالتوفيق

ترحيل أيام الغياب.xlsb

[ABOU ELSAAD]

الاستاذ محمد صالح   سبحان الله وكانك تقرا ما بخاطري

عندما قمت بتجربة كود الاستاذ ابراهيم جزاه الله خيرا حدث ما قلته بالضبط فظهرت الارقام معكوسة فقمت بحذف 

StrReverse  حتى تظهر الارقام بصورتها الصحيحة 

فاذا بحضرتك تفيض علي من كرمك بحل رائع 

فجزاك الله خير الجزاء وزادك من فضله

 

تم تعديل أكتوبر 8, 2021 بواسطه ABOU ELSAAD

[أ / محمد صالح]

جميعا بإذن الله

 

[ABOU ELSAAD]

استاذ محمد 

بعد اذن حضرتك لي طلب اخر

هل من الممكن الاختصار بحيث اذا كانت ايام الغياب متتالية

مثل غياب يوم ( 1و2و3و4و5و6) ان تختصر الى غياب يوم (1-6) 

[محمد عدنان]

السلام عليكم 

الله يعطيك العافية 

سؤالى هل من الممكن  بدل تعبئة الغياب برقم و ليكن حرف " غ "  ثم بماكرو في صفحة ثانية يقوم بترحيل الغياب على شكل يوم و تاريخ لكل شخص ؟

[ابراهيم الحداد]

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

الاخ    ABOU ELSAAD

يمكنك استخدام الكود التالى

Sub AbsCount()
Dim ws As Worksheet, LR As Long
Dim x As Long
Dim a As Integer, b As Integer, d As Integer
Dim C As Range, Abst As String
Const Com = ","

Set ws = Sheets("SS")
x = 3
LR = ws.Range("AG" & Rows.Count).End(xlUp).Row
Do While x <= LR
For Each C In ws.Range("A" & x & ":AE" & x)
If C.Value > 0 Then
a = WorksheetFunction.Min(ws.Range("A" & x & ":AE" & x))
b = WorksheetFunction.Max(ws.Range("A" & x & ":AE" & x))
ab = b - a + 1
d = WorksheetFunction.Count(ws.Range("A" & x & ":AE" & x))
If ab = d And d > 1 Then
Abst = " يوم " & " (" & a & " - " & b & ")"
ws.Range("AL" & x) = Abst
Else
Abst = C.Value & Com & Abst
ws.Range("AL" & x) = Left(Abst, Len(Abst) - 1)
End If
End If

Next C
Abst = ""
x = x + 1
Loop

End Sub

 

[ABOU ELSAAD]

استاذ ابراهيم الحداد

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

 تعجز الكلمات عن التعبير عن مدى امتناني وشكري لحضرتك 

فجزاك الله خير الجزاء في الدنيا والاخرة 

واسف على تعب حضرتك معي

[هشام جودي]

السلام عليكم

بارك الله فيكم 

عمل ممتـــاز