معادلة لجلب اخر استلام

[kkfhvvv]

السلام عليكم

محتاج معادلة لجلب اخر استلام 

وكما موضحة النتائج المطلوبة بالملف المرفق

مشكورين

 

التاريخ الاخير الذي استلم.xlsx

تم تعديل April 9 بواسطه kkfhvvv

[محمد هشام.]

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

 لجلب اخر  تاريخ استلام 

=IFERROR(IF(NOT(ISBLANK(A2));LOOKUP(2;1/INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0)
;البيانات!$B$1:$M$1);"");"لم يستلم")

لجلب المبلغ الكلي

=IFERROR(SUM(INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0));"")

لجلب اخر قيمة مدخلة 

=IFERROR(LOOKUP(2;1/INDEX(البيانات!$B$2:$M$11;MATCH(الخلاصة!A2;البيانات!$A$2:$A$11;0);0);البيانات!B2:M2);"لم يستلم")

 

 في حالة الرغبة باستخدام الاكواد 

 

 

Sub test()
Dim lastrow As Long, lige As Long, lastcol As Long
Dim WS As Worksheet: Set WS = Sheets("البيانات")
Dim desWS As Worksheet: Set desWS = Sheets("الخلاصة")

With Application
    .ScreenUpdating = False
    .Calculation = xlManual
    
F = WS.Name

lastrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastcol = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

Set A = WS.Range("B2:M" & lastrow): Set B = WS.Range("A2:A" & lastrow)
Set C = WS.Range("B1", WS.Cells(1, lastcol))

lige = desWS.Range("A:D").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
         desWS.Range("B2:C" & lige).ClearContents

With desWS.Range("B2:B" & lige)
.Formula2 = "=IFERROR(IF(NOT(ISBLANK('" & desWS.Name & "'!A2)),LOOKUP(2,1/INDEX('" & F & "'!" & A.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0),'" & F & "'!" & C.Address & "),""""),""لم يستلم"")"
  .Value = .Value

With desWS.Range("C2:C" & lige)
.Formula2 = "=IFERROR(SUM(INDEX('" & F & "'!" & A.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)),"""")"
   .Value = .Value
   
       End With
      End With
   .ScreenUpdating = True
  .Calculation = xlAutomatic
 End With
End Sub

بالتوفيق...........

التاريخ الاخير الذي استلم Formula.xlsx التاريخ الاخير الذي استلم VBA.xlsb

[kkfhvvv]

جزاك الله خير

وحفظكم الله من كل مكروه وسوء

مشكور - وفي حالة بيان اول تاريخ استلام - بدل اخر استلام - ماذا استخدم من المعادلات

 

اما بالنسبة الكود - توجد مشكلة كما مبينة بالصورة

 

تم تعديل April 11 بواسطه kkfhvvv

[محمد هشام.]

14 ساعات مضت, kkfhvvv said:

في حالة بيان اول تاريخ استلام - بدل اخر استلام - ماذا استخدم من المعادلات

يمكنك جلب اول تاريخ استلام باستخدام المعادلة التالية فقط لاكن دون شرط الاسم بمعني اول تاريخ مدخل على الصف 

=IFERROR(INDEX(البيانات!B$1:M$1; MATCH(TRUE; INDEX(البيانات!B2:M2<>""; 0); 0));"لم يستلم")

لهدا سنقوم بتعديل المعادلة بالشكل التالي لاظافة شرط الاسم الموجود في العمود A

=IF(A2<>"";IFERROR(INDEX(البيانات!$1:$1;AGGREGATE(15;6;COLUMN(البيانات!$B$1:$M$1)/
(INDEX(البيانات!$B$2:$M$11;MATCH(A2;البيانات!$A$2:$A$11;0);0)<>"");1));"لم يستلم");"")

 

14 ساعات مضت, kkfhvvv said:

اما بالنسبة الكود - توجد مشكلة كما مبينة بالصورة

الكود يشتغل عندي بشكل جيد لااعلم صراحة ما سبب عدم اشتغاله معك  على العموم قم بتجربة الكود التالي  بعد اظافة معادلة جلب اول تاريخ استلام في عمود D 

Sub test()                                                 
Dim lastrow As Long, lige As Long, lastcol As Long
Dim WS As Worksheet: Set WS = Sheets("البيانات")
Dim desWS As Worksheet: Set desWS = Sheets("الخلاصة")

With Application
    .ScreenUpdating = False
    .Calculation = xlManual
    
F = WS.Name

'***جلب الاسماء من ورقة البيانات بدون تكرار مع تجاهل الفراغات*****

Set Cpt = CreateObject("Scripting.Dictionary")
  a = Range(WS.[A2], WS.[a65000].End(xlUp)).Value
  For Each c In a
     Cpt(c) = ""
  Next c
  Set dest = desWS.[A2]
  desWS.Range("A2:D" & Rows.Count).ClearContents
  dest.Resize(Cpt.Count, 1) = Application.Transpose(Cpt.keys)
  ' ترتيب ابجدي
  dest.Resize(Cpt.Count, 1).Sort Key1:=dest, Order1:=xlAscending
  
Set Cpt = Nothing
lastrow = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastcol = WS.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
lige = desWS.Range("A:A").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
' نطاق البيانات
Set a = WS.Range("B2:M" & lastrow): Set B = WS.Range("A2:A" & lastrow)
' رؤوس الاعمدة
Set c = WS.Range("B1", WS.Cells(1, lastcol))
      
Set r = WS.Range("$1:$1")

' جلب اخر تاريخ استلام بشرط الاسم
With desWS.Range("B2:B" & lige)
.Formula = "=IFERROR(IF(NOT(ISBLANK('" & desWS.Name & "'!A2)),LOOKUP(2,1/INDEX('" & F & "'!" & a.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0),'" & F & "'!" & c.Address & "),""""),""لم يستلم"")"

' جلب مجموع قيم الصف بشرط الاسم
With desWS.Range("C2:C" & lige)
.Formula = "=IFERROR(SUM(INDEX('" & F & "'!" & a.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)),"""")"
   
' جلب اول تاريخ استلام بشرط الاسم
With desWS.Range("D2:D" & lige)
 .Formula = "=IF('" & desWS.Name & "'!A2<>"""",IFERROR(INDEX('" & F & "'!" & r.Address & ",AGGREGATE(15,6,COLUMN('" & F & "'!" & c.Address & ")/(INDEX('" & F & "'!" & a.Address & ",MATCH('" & desWS.Name & "'!A2,'" & F & "'!" & B.Address & ",0),0)<>""""),1)),""لم يستلم""),"""")"
      '
      Range("B2:D" & lige).Value = Range("B2:D" & lige).Value
      
       End With
     End With
 End With
 
   .ScreenUpdating = True
  .Calculation = xlAutomatic
 End With
End Sub

 

 

جلب اول واخر الاستلامات + المجموع.rar

تم تعديل April 12 بواسطه محمد هشام.

[kkfhvvv]

السلام عليكم

- تسلم استاذ

زادتك الله من فضله

وحفظك الله من كل مكروه وسوء

وجزاك الله عنا خير

تمام 100 %