مطلوب معادلة للتجميع حسب شرطين

[حسام مصطفي]

السلام عليكم

مرفق سيادتكم ملف به عدد 2  شيت  الشيت الاول به بيانات يتم تسجيله

بشكل دوري ورا بعضها البعض بدون ترتيب 

وفي الشيت الثاني مطلوب  تجميع عدد الاجازات حسب نوع الاجازة لكل موظف بناءا علي رقم ملف الموظف

الملف المرفق يوضح اكثر

كنت احاول استخدام دالة SUM IF

تجميع ب sumif.xls

[نزار سليمان عيد]

وعليكم السلام

تم عمل المطلوب حسب الصورة ادناه وتمت اضافة طريقة اخرى اسفل الجدول عن طريق القوائم المنسدلة جرب واي استفسار اعلمني

تجميع ب sumif.xls

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

بعد اذن الاستاذ نزار   هذا الكود

Option Explicit

Sub Fil_Ijasat()
  Dim Dic As Object, KY
  Dim I%, lr%, m%, K%
  Dim txt
  Dim EE#, FF#, HH#, JJ#, GG#, II#, KK#
  Dim Source_Sheet As Worksheet
  Dim Target_Sheet As Worksheet
  Dim Cur_Value

  Set Source_Sheet = Sheets("Sheet1")
  Set Target_Sheet = Sheets("Sheet2")
  Set Dic = CreateObject("Scripting.Dictionary")

lr = Source_Sheet.Cells(Rows.Count, 2).End(3).Row
Target_Sheet.Range("a3:k100").ClearContents
If lr < 4 Then Exit Sub
 For I = 4 To lr
  txt = Source_Sheet.Cells(I, 2).Resize(, 3)
  txt = Application.Transpose(txt)
  txt = Application.Transpose(txt)
  txt = Join(txt, "*")
  Dic(txt) = Dic(txt) + Val(Source_Sheet.Cells(I, 7))
 Next I
 If Dic.Count Then
   m = 3
    For Each KY In Dic
      Target_Sheet.Cells(m, 1) = m - 2
      Target_Sheet.Cells(m, 2).Resize(, 3).Value = _
      Split(KY, "*")
      m = m + 1
    Next KY
   End If
   Set Dic = Nothing
If m > 3 Then
    For I = 3 To m - 1
        For K = 4 To lr
            If Target_Sheet.Cells(I, 2) = Source_Sheet.Cells(K, 2) Then
             Cur_Value = Val(Source_Sheet.Cells(K, 7))
              Select Case Trim(Source_Sheet.Cells(K, 8))
                Case "اعتيادي": EE = EE + Cur_Value
                Case "عارضة": FF = FF + Cur_Value
                Case "اذن": HH = HH + Cur_Value
                Case "تناوب": JJ = JJ + Cur_Value
                Case "انقطاع": GG = GG + Cur_Value
                Case "راحة": II = II + Cur_Value
                Case "مرضي": KK = KK + Cur_Value
              End Select
            End If
        Next K
         With Target_Sheet.Cells(I, 5)
            .Value = IIf(EE = 0, "", EE)
            .Offset(, 1) = IIf(FF = 0, "", FF)
            .Offset(, 2) = IIf(GG = 0, "", GG)
            .Offset(, 3) = IIf(HH = 0, "", HH)
            .Offset(, 4) = IIf(II = 0, "", II)
            .Offset(, 5) = IIf(JJ = 0, "", JJ)
            .Offset(, 6) = IIf(KK = 0, "", KK)
         End With
        EE = 0: FF = 0: GG = 0: HH = 0
        II = 0: JJ = 0: KK = 0
    Next I
End If

End Sub

الملف مرفق

Ijasat.xlsm

[نزار سليمان عيد]

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

دائما مبدع ومتالق ماشاء الله عليك ربنا يحفظك

[حسام مصطفي]

السلام عليكم 

استاذ/ نزار سليمان عيد

بارك الله فيك رووووعه كما تمنيت بالضبط

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

السلام عليكم 

استاذ/ سليم حاصبيا

 بارك الله فيك رووووعه كما تمنيت بالضبط

كود ولا اروع ولا اجمل من ذلك وخفيف جدا

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