مالخطاء فى هذا الكود

[mahmoud nasr alhasany]

بحث عن الاصناف الراكدة فى المخاذن على حسب اقل كمية والتاريخ بالايام

Sub FindStagnantItemsWithCriteria3()

  ' تعريف الأوراق والمتغيرات
  Dim wsMain As Worksheet, wsResults As Worksheet
  Dim wsOther As Worksheet ' تعريف متغير لورقة العمل الأخرى
  Dim wsOtherSheet As Worksheet ' متغير لتمثيل ورقة عمل المخزن الآخر
  Dim lastRow As Long, i As Long, lastRowOther As Long ' تعريف lastRowOther
  Dim item As String, lastMovementDate As Date
  Dim minQuantity As Integer, productType As String
  Dim stagnantItems As New Collection
  Dim stagnantPeriod As Integer
  Dim otherStores As String
  Dim otherStoresRange As Range
On Error Resume Next
  ' تحديد الأوراق والمعايير
  Set wsMain = ThisWorkbook.Sheets("مخزن_الأساسي")
  ' تحديد أوراق العمل الأخرى كمجموعة
  Dim wsOtherSheets As Variant
  wsOtherSheets = Array("مخزن_آخر", "مخزن_آخر 1", "مخزن_آخر 2", "مخزن_آخر 3", "مخزن_آخر 4") ' يمكنك إضافة المزيد هنا
'  minQuantity = 10
  productType = "أجهزة إلكترونية"
'  stagnantPeriod = 90
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  minQuantity = InputBox("أدخل الكمية ولنفترض 10:", "تحديد كمية الرقود")
  stagnantPeriod = CInt(InputBox("أدخل فترة الركود ولنفترض 90 (بالأيام):", "تحديد فترة الركود"))
  If stagnantPeriod = 0 Then
      MsgBox "لم يتم إدخال فترة ركود صحيحة.", vbExclamation
      Exit Sub
  End If
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

  ' إنشاء ورقة عمل جديدة للنتائج
  On Error Resume Next ' لتجنب الخطأ إذا كانت الورقة موجودة بالفعل
  Set wsResults = ThisWorkbook.Sheets("أصناف_راكدة")
  On Error GoTo 0
  If wsResults Is Nothing Then ' إذا لم تكن الورقة موجودة ، قم بإنشائها
    Set wsResults = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
    wsResults.Name = "أصناف_راكدة"
  End If

  ' تحديد الأعمدة بمتغيرات
  Const colItem As Integer = 1 ' عمود رقم الصنف
  Const colLastMovement As Integer = 3 ' عمود تاريخ اخر حركة
  Const colQuantity As Integer = 4 ' عمود الكمية
  Const colProductType As Integer = 5 ' عمود نوع المنتج
  Const colOtherStores As Integer = 6 ' عمود جديد للمخازن الأخرى

  ' عنوان التقرير
  wsResults.Range("A1").Value = "أصناف راكدة في " & wsMain.Name & " مع معايير إضافية"
  wsResults.Range("A2:F2").Value = Array("رقم الصنف", "اسم الصنف", "آخر حركة", "الكمية", "نوع المنتج", "مخازن أخرى")

  ' تحديد الصف الأخير في ورقة العمل الرئيسية
  lastRow = wsMain.Cells(wsMain.Rows.Count, "A").End(xlUp).Row

  ' البحث عن الأصناف الراكدة وتسجيلها في مجموعة
  For i = 2 To lastRow
    item = wsMain.Cells(i, colItem).Value
    lastMovementDate = wsMain.Cells(i, colLastMovement).Value
    If DateDiff("D", lastMovementDate, Date) > stagnantPeriod And _
       wsMain.Cells(i, colQuantity).Value < minQuantity And _
       wsMain.Cells(i, colProductType).Value = productType Then
      stagnantItems.Add item
    End If
  Next i

  ' كتابة النتائج في ورقة العمل مع تحسينات
  Dim itemIndex As Variant
  i = 3
  For Each itemIndex In stagnantItems
    wsResults.Cells(i, colItem).Value = itemIndex
    wsResults.Cells(i, colItem + 1).Value = wsMain.Cells.Find(What:=itemIndex, LookIn:=xlValues, LookAt:=xlWhole).Offset(0, 1).Value
    wsResults.Cells(i, colLastMovement).Value = lastMovementDate
    wsResults.Cells(i, colQuantity).Value = wsMain.Cells(i, colQuantity).Value
    wsResults.Cells(i, colProductType).Value = wsMain.Cells(i, colProductType).Value
  
  '      On Error Resume Next ' لمعالجة الأخطاء إذا لم يتم العثور على الصنف

    ' البحث في المخازن الأخرى مع تحسينات
    otherStores = "" ' تهيئة المتغير
    For Each wsOtherSheet In wsOtherSheets ' استخدام المصفوفة التي تحتوي على أسماء أوراق العمل
      On Error Resume Next ' لمعالجة الأخطاء إذا لم يتم العثور على الصنف
      With wsOtherSheet ' استخدام With لتسهيل الرجوع إلى ورقة العمل
        lastRowOther = .Cells(.Rows.Count, "A").End(xlUp).Row ' تحديد الصف الأخير ديناميكيًا
        Set otherStoresRange = .Range("A2:F" & lastRowOther) ' تحديد النطاق ديناميكيًا
        otherStores = Application.WorksheetFunction.VLookup(itemIndex, otherStoresRange, 1, False)
      End With
      On Error GoTo 0
      If otherStores <> "" Then ' إذا تم العثور على الصنف في المخزن الآخر
        otherStores = wsOtherSheet.Name & ": " & otherStores & ", " & otherStores ' بناء سلسلة المخازن الأخرى
      End If
    Next wsOtherSheet
    wsResults.Cells(i, colOtherStores).Value = Left(otherStores, Len(otherStores) - 2) ' إزالة الفاصلة الأخيرة

    i = i + 1
  Next itemIndex
Call Macro2_Improved_Dynamic
End Sub

 

اصناف راكدة 2027ومتحركة.xlsm

[mahmoud nasr alhasany]

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

مثل العمود c فى ورقة عمل اصناف راكدة تجدها كلها تاريخ واحد وهى 08/10/2024 كما فى هذا الشكل الظاهر فى الصورة

تم تعديل فبراير 3 بواسطه mahmoud nasr alhasany

[mahmoud nasr alhasany]

الرجاء المساعدة

[أبوعيد]

السلام عليكم

واضح من الصورة التي أرفقتها أن المشكلة في العمود C

وحتى يتم حل المشكلة أريد أن أعرف 

ما هي النتيائج الصحيحة (النتائج المتوقعة ) ؟ من أين يتم جلب هذه التواريخ ؟ من أي شيت ؟