اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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


ABOU ELSAAD
إذهب إلى أفضل إجابة Solved by أ / محمد صالح,

الردود الموصى بها

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

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

المطلوب المساعدة في  كود يقوم بترحيل ايام الغياب من الكشف الى العمود 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

 

  • Like 5
رابط هذا التعليق
شارك

  • أفضل إجابة

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

لا نحتاج لعكس الكلام لأنه يظهر الأرقام مقلوبة مثل 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

  • Like 6
رابط هذا التعليق
شارك

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

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

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

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

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

 

تم تعديل بواسطه ABOU ELSAAD
  • Like 3
رابط هذا التعليق
شارك

السلام عليكم 

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

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

  • Like 1
رابط هذا التعليق
شارك

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

الاخ    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

 

  • Like 6
رابط هذا التعليق
شارك

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

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

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

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

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

  • Like 1
رابط هذا التعليق
شارك

  • 3 weeks later...
زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information