logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
noureddine70 لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة YasserKhalil برنامج فك حماية محرر الأكواد VBA وحماية unviewable اكسيل اسئله واجابات



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





17-01-2020 08:47 صباحاً
معلومات الكاتب ▼
تاريخ الإنضمام : 11-11-2017
رقم العضوية : 1466
المشاركات : 181
الجنس :
تاريخ الميلاد : 20-12-1973
قوة السمعة : 121
الاعجاب : 1

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

اخواني أعضاء المنتدى اشكركم على تقديم يد العون للجميع

لدي سؤال مرفق في الملف وهو بخصوص ترحيل الغياب من شيت الغياب إلى شيت الارشيف شهريا

وشكرا مقدما
 
 
  ترحيل الغياب.xlsm   تحميل xlsm مرات التحميل :(19)
الحجم :(234.756) KB





look/images/icons/i1.gif ترحيل الغياب إلى أرشيف الغياب
  17-01-2020 11:19 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1765
الدولة : مصر
الجنس :
الدعوات : 2
قوة السمعة : 9685
الاعجاب : 25
وعليكم السلام-تم عمل اللازم من قبل الأستاذ سليم حاصبيا بكود ممتاز
CODE
Option Explicit
Sub ABSCENT()
Application.Calculation = xlCalculationManual
  Dim K As Worksheet, A As Worksheet
  Dim Ro_K%, col%, Ro_A%, i%, m%, t%: t = 1
  Dim ALL$, ALPHA$, Str$: Str = "غ"
  ALL$ = " ": ALPHA = " "
Set K = Sheets("keab"): Set A = Sheets("arhkeab")
Ro_K = K.Cells(Rows.Count, 2).End(3).Row
If Ro_K < 5 Then Exit Sub
  Ro_A = A.Cells(Rows.Count, 2).End(3).Row
  m = IIf(Ro_A < 5, 5, Ro_A + 2)

 For i = 5 To Ro_K
      If Application.CountIf(K.Cells(i, 6).Resize(1, 31), Str) = 0 Then _
      GoTo My_next
        A.Cells(m, 2).Resize(, 2).Value = _
        K.Cells(i, 2).Resize(, 2).Value
        
        For col = 6 To 36
            If K.Cells(i, col) = Str Then
             ALL = ALL & Day(K.Cells(4, col)) & "-"
             ALPHA = ALPHA & K.Cells(3, col) & "-"
             t = t + 1
            End If
         Next col
      
      If t > 1 Then
      With A.Cells(m, 4)
       .Value = Mid(ALL, 1, Len(ALL) - 1)
       .Offset(, 1) = Mid(ALPHA, 1, Len(ALPHA) - 1)
       .Offset(, 2) = t - 1
       .Offset(, 3) = K.Cells(2, "Q")
       .Offset(, 4) = Year(Date)
      End With
      
      m = m + 1
      End If
My_next:
    t = 1
    ALL = " ": ALPHA = " "
 Next i
 Application.Calculation = xlCalculationAutomatic
End Sub



توقيع :ali mohamed ali


{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
الاخرين لوجه الله وان تحتسب له اجر عند الله

look/images/icons/i1.gif ترحيل الغياب إلى أرشيف الغياب
  17-01-2020 11:49 صباحاً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
أخي الكريم خيري
عند طرح موضوع في أكثر من منتدى مراعاة وضع روابط الموضوع في المنتديات الأخرى .. وإلا سنقوم بحذف الموضوع




look/images/icons/i1.gif ترحيل الغياب إلى أرشيف الغياب
  17-01-2020 02:14 مساءً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 11-11-2017
رقم العضوية : 1466
المشاركات : 181
الجنس :
تاريخ الميلاد : 20-12-1973
قوة السمعة : 121
الاعجاب : 1
مشكور جدا استاذ ياسر. ولكن كنت مستعجل للحصول على الاجابة




look/images/icons/i1.gif ترحيل الغياب إلى أرشيف الغياب
  17-01-2020 07:18 مساءً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10525
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36745
الاعجاب : 182
لا عليك أخي الكريم ويرجى وضع الروابط في كلا الموضوعين

أقصد أن تضع هنا رابط الموضوع في المنتدى الآخر هنا ، وتضع رابط هذا الموضوع هناك




اضافة رد جديد اضافة موضوع جديد



المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
انجاز ورقة الغيابات باستعمال دمج المراسلات chardoneret
0 37 chardoneret
سجل الغياب الإلكتروني للمدارس (تقرير الغياب الأسبوعي) YasserKhalil
104 10675 محمد حسن المحمد
حساب الغياب الشهري للتلميذ بعد الفلترة chardoneret
1 1135 chardoneret
ملخص تقرير الغيابات mostachar
0 779 mostachar
عمل كود او معادلة لحساب عدد ساعات الدوام وايام الغياب omhamza
5 1386 YasserKhalil

الكلمات الدلالية
ترحيل ، الغياب ، أرشيف ، الغياب ،









اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 06:48 AM