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

حساب قيمة معينة في اكثر من جدول


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

 

 

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

 

لدي جدول للموظفين وارغب في جمع عدد الاجازات مثلا في جدول ثابت 

 

مثلا ُ الموظف خالد في الاسبوع الاول لدية إجازة لمدة يومين وفي الاسبوع الاخير إجازة لمدة 5 أيام ، المطوب هو تسجيل عدد إيام الاجازة تلقائياً في جدول مستقل 

 

اي اثناء تعبئة الجدول بأيام الاجازات يتم حسابها في الجدول المستقل تلقائياً . وهكذا . 

 

 

D.rar

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

جرب هذا الكود في موديول منفصل وقم باستدعائه

Option Explicit
Sub do_it()
    Dim a, b, c, d, e As Long
    Dim rng1, rng2, rng3 As Range
    Dim row, cell As Range
    Set rng2 = Range("i12").CurrentRegion
    rng2.Offset(1, 1).ClearContents
    a = Range("a1").CurrentRegion.Columns.Count / 8
    Set rng1 = Range("a3", Range("A" & Rows.Count).End(xlUp)).Resize(, 8)
    For b = 1 To a
        Select Case b
        Case Is > 1
            Set rng1 = rng1.Offset(, 8)
            rng1.Select
            For Each row In rng1.Rows
                If Application.WorksheetFunction.CountIf(row, "EXM") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 1).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "EXM")
                End If
                If Application.WorksheetFunction.CountIf(row, "VIC") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 2).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "VIC")
                End If
                If Application.WorksheetFunction.CountIf(row, "SICK") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 3).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "SICK")
                End If
            Next
        Case Is = 1
            For Each row In rng1.Rows
                If Application.WorksheetFunction.CountIf(row, "EXM") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 1).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "EXM")
                End If
                If Application.WorksheetFunction.CountIf(row, "VIC") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 2).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "VIC")
                End If
                If Application.WorksheetFunction.CountIf(row, "SICK") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 3).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "SICK")
                End If
            Next
        End Select
    Next
End Sub

 

 

D.xlsm

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

8 دقائق مضت, سليم حاصبيا said:

جرب المرفق

 

D salim.xlsx

 

أستاذ سليم أشكرك على ما قمت به لكن الاسماء متغيره في الجدول أي ان الترتيب يختلف من جدول الى آخر . 

 

مثلاً أحمد في ترتيب الأسبوع الاول في الجدول رقم واحد 

 

اما في ترتيب الاسبوع الثاني من الجدول يصبح 2 

 

شكراً 

 

 

3 دقائق مضت, shreif mohamed said:

جرب هذا الكود في موديول منفصل وقم باستدعائه


Option Explicit
Sub do_it()
    Dim a, b, c, d, e As Long
    Dim rng1, rng2, rng3 As Range
    Dim row, cell As Range
    Set rng2 = Range("i12").CurrentRegion
    rng2.Offset(1, 1).ClearContents
    a = Range("a1").CurrentRegion.Columns.Count / 8
    Set rng1 = Range("a3", Range("A" & Rows.Count).End(xlUp)).Resize(, 8)
    For b = 1 To a
        Select Case b
        Case Is > 1
            Set rng1 = rng1.Offset(, 8)
            rng1.Select
            For Each row In rng1.Rows
                If Application.WorksheetFunction.CountIf(row, "EXM") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 1).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "EXM")
                End If
                If Application.WorksheetFunction.CountIf(row, "VIC") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 2).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "VIC")
                End If
                If Application.WorksheetFunction.CountIf(row, "SICK") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 3).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "SICK")
                End If
            Next
        Case Is = 1
            For Each row In rng1.Rows
                If Application.WorksheetFunction.CountIf(row, "EXM") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 1).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "EXM")
                End If
                If Application.WorksheetFunction.CountIf(row, "VIC") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 2).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "VIC")
                End If
                If Application.WorksheetFunction.CountIf(row, "SICK") > 0 Then
                    rng2.Find(row.Cells(1)).Offset(, 3).Select
                    Selection = Selection + Application.WorksheetFunction.CountIf(row, "SICK")
                End If
            Next
        End Select
    Next
End Sub

 

 

 

أستاذي شريف 

 

ممكن شرح طريق عمل هذا الكود على الواقع لاني بصراحه لا أعرف . شكراً للجميع 

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

16 دقائق مضت, سليم حاصبيا said:

في هذه الحالة انظر الى الصفحة SALIM من هذا الملف

 

 

D salim1.xlsx

 

 

شكراُ لك من الاعماق أستاذي سليم ، ولكن ماذا لو كان الجدول على مدار العام اي 51 اسبوع ؟ 

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

6 minutes ago, نهاية فوضوي said:

 

 

شكراُ لك من الاعماق أستاذي سليم ، ولكن ماذا لو كان الجدول على مدار العام اي 51 اسبوع ؟ 

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

 

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

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
×
  • اضف...

Important Information