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

[نهاية فوضوي]

 

 

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

 

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

 

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

 

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

 

 

D.rar

[سليم حاصبيا]

جرب المرفق

 

D salim.xlsx

[shreif mohamed]

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

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

 

 

 

أستاذي شريف 

 

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

[سليم حاصبيا]

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

 

 

D salim1.xlsx

[نهاية فوضوي]

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

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

 

 

D salim1.xlsx

 

 

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

[shreif mohamed]

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

 

 

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

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

 

[نهاية فوضوي]

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

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

 

 

 

كل الشكر عزيزي 

[سليم حاصبيا]

اذا كنت تريدها بواسطة الماكرو =======> هذا الملف (صفحة Salim_Macro)

 

D salim1_Macro.xlsm