عرض الاصناف الراكدة لكل مخزن

[mahmoud nasr alhasany]

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

الرجاء مساعدتى اذا سمحتم

يوجد شيت تجريبى نبذة للعمل المطلوب  اريد معرفة الاصناف الراكدة والمتحركة لكل مخزن كما هو موضح فى الكود

يوجد مشكلة فى الكود لعدم استعراض الاصناف الراكدة

وذلك من خلال صلاحية حركة المنتج والكمية

 

Sub FindStagnantItems()
    Dim ws As Worksheet, wsOutput As Worksheet
    Dim lastRow As Long, i As Long
    Dim item As String, category As String, lastMovementDate As Date
    Dim stagnantItemsByCategory As Object
    Dim warehouseNames As Variant
    Dim stagnantPeriod As Integer
    Dim totalStagnantItemsByCategory As Object

    ' تحديد الفترة التي تعتبر بعدها الصنف راكدًا
    stagnantPeriod = 90

    ' تحديد أسماء أوراق العمل التي تمثل المخازن
    warehouseNames = Array("مخزن الرئيسي", "فرع 1")

    ' إنشاء قاموس لتخزين الأصناف الراكدة حسب التصنيف
    Set stagnantItemsByCategory = CreateObject("Scripting.Dictionary")
    Set totalStagnantItemsByCategory = CreateObject("Scripting.Dictionary")
    ' تكرار العملية لكل مخزن
    For Each warehouseName In warehouseNames
        
        On Error Resume Next
Set ws = ThisWorkbook.Sheets(warehouseName)
If Err.Number <> 0 Then
    MsgBox "حدث خطأ في الوصول إلى ورقة العمل: " & Err.Description
    Exit Sub
End If
On Error GoTo 0
        
        
        lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row

        ' البحث عن الأصناف الراكدة في المخزن الحالي
        For i = 2 To lastRow
            item = ws.Cells(i, 1).Value
            category = ws.Cells(i, 4).Value
            lastMovementDate = ws.Cells(i, 3).Value

            If DateDiff("d", lastMovementDate, Date) > stagnantPeriod Then
                If Not stagnantItemsByCategory.Exists(category) Then
                    stagnantItemsByCategory.Add category, New Collection
                End If
                stagnantItemsByCategory(category).Add item

                ' حساب إجمالي الأصناف الراكدة لكل تصنيف
                If Not totalStagnantItemsByCategory.Exists(category) Then
                    totalStagnantItemsByCategory.Add category, 1
                Else
                    totalStagnantItemsByCategory(category) = totalStagnantItemsByCategory(category) + 1
                End If
            End If
        Next i
    Next warehouseName

    ' إنشاء ورقة عمل جديدة لعرض النتائج
    Set wsOutput = Worksheets.Add
    wsOutput.Name = "أصناف راكدة"
    wsOutput.Range("A1").Value = "التصنيف"
    wsOutput.Range("B1").Value = "عدد الأصناف الراكدة"

    ' عرض النتائج
    Dim categoryName As Variant
    Dim currentRow As Long
    currentRow = 2
    For Each categoryName In totalStagnantItemsByCategory.Keys
        wsOutput.Cells(currentRow, 1).Value = categoryName
        wsOutput.Cells(currentRow, 2).Value = totalStagnantItemsByCategory(categoryName)
        currentRow = currentRow + 1
    Next categoryName
End Sub

 

الاصناف الراكدة لكل مخزن.xlsm

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

[محمد هشام.]

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

جرب هدا

Option Explicit
Sub FindStagnantItems()
    Const stagnantPeriod As Integer = 90
    Dim WS As Worksheet, dest As Worksheet, ShArr As Variant, Ky As Object
    Dim lastRow As Long, i As Long, d As Object, cate As Variant, Irow As Long
    Dim item As String, Store As String, Movement As Date, C As Variant
    
    ShArr = Array("مخزن الرئيسي", "فرع 1")
    Set d = CreateObject("Scripting.Dictionary"): Set Ky = CreateObject("Scripting.Dictionary")
    For Each C In ShArr
        On Error Resume Next
        Set WS = ThisWorkbook.Sheets(C)
        On Error GoTo 0
        
    If WS Is Nothing Then MsgBox "خطأ في الوصول إلى الورقة: " & C, vbCritical: Exit Sub
        Application.ScreenUpdating = False
        lastRow = WS.Cells(WS.Rows.Count, 1).End(xlUp).Row
        For i = 2 To lastRow
    item = WS.Cells(i, 1).Value: Store = WS.Cells(i, 4).Value: Movement = WS.Cells(i, 3).Value
    If item <> "" And Store <> "" Then
        If IsDate(Movement) Then
            If DateDiff("d", Movement, Date) > stagnantPeriod Then
                If Not d.Exists(Store) Then d.Add Store, New Collection
                If Not n(d(Store), item) Then d(Store).Add item
                Ky(Store) = Ky(Store) + 1
             End If
           End If
        End If
      Next i
    Next C
    On Error Resume Next: Set dest = Worksheets("أصناف راكدة"): On Error GoTo 0
    If dest Is Nothing Then
        Set dest = Worksheets.Add: dest.Name = "أصناف راكدة"
    Else
        dest.Cells.ClearContents
    End If
    dest.[A1].Resize(1, 2) = Array("التصنيف", "عدد الأصناف الراكدة")
    Irow = 2
    For Each cate In Ky.keys
        dest.Cells(Irow, 1).Value = cate
        dest.Cells(Irow, 2).Value = Ky(cate)
        Irow = Irow + 1
    Next cate
    Application.ScreenUpdating = True
    MsgBox "تم إنشاء تقرير الأصناف الراكدة بنجاح", vbInformation
End Sub
Function n(col As Collection, val As String) As Boolean
    On Error Resume Next
    n = Not IsError(col(val))
End Function

 

 

الاصناف الراكدة لكل مخزن.xlsm

تم تعديل يناير 17 بواسطه محمد هشام.

[mahmoud nasr alhasany]

الف شكر ا/ محمد هشام

للمساعدة

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

الاصناف الراكدة لكل مخزن(1).xlsm

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

[mahmoud nasr alhasany]

اريد استدعاء كل البيانات والاصناف الراكدة بناء على عدد الاصناف الراكدة بالاغلى 

 

 

الاصناف الراكدة لكل مخزن(1) - Copy - Copy.xlsm

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

[mahmoud nasr alhasany]

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

تم حل مشكلة الاصناف الراكدة وجلبها فى سيت اصناف راكدة

اولا الرجاء مساعدتى فى تنسيق التاريخ فى العمود D

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

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

ملحوظة الافرع عبارة عن محافظات

 

 

Copy of الاصناف الراكدة لكل مخزن(3) - Copy - Copy.xlsm

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

[mahmoud nasr alhasany]

الرجاء مساعدتى انى عالق

Copy of الاصناف الراكدة لكل مخزن(3) - Copy - Copy(1).xlsm

[عبدللرحيم]

تم تنسيق التاريخ 

ارجو توضيح الطلب الثانى

 

الاصناف الراكدة لكل مخزن(4).xlsm

تم تعديل يناير 22 بواسطه عبدللرحيم
تعديل تنسيق التاريخ

[عبدللرحيم]

(تحديث) مرفق مقترح للمقارنة هل يفى بالمطلوب

 

الاصناف الراكدة لكل مخزن(5).xlsm

[mahmoud nasr alhasany]

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

شكرا   ا/ عبدللرحيم

نعم انه المطلوب مقارنة كميات الاصناف الراكدة والمتحركة للافرع

ولاكن اين الكود المرفق فى مقارنة الاصناف بين الافرع

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

[mahmoud nasr alhasany]

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

اريد كود لعرض كميات الاصناف على حسب كل فرع سواء متحركة او راكدة

Sub مقارنة_الاصناف()
 Const stagnantPeriod As Integer = 90
  Dim ws As Worksheet, dest As Worksheet, ShArr As Variant, Ky As Object, KyStagnant As Object
  Dim lastRow As Long, i As Long, d As Object, cate As Variant, Irow As Long
  Dim item As String, item_Name As String, Store As String, Movement As Date, C As Variant
  Dim quantity As Double

  ShArr = Array("مخزن الرئيسي", "فرع 1", "فرع 2", "فرع 3", "فرع 4", "فرع 5")
  Set d = CreateObject("Scripting.Dictionary")
  Set Ky = CreateObject("Scripting.Dictionary") ' لحساب الأصناف المتحركة
  Set KyStagnant = CreateObject("Scripting.Dictionary") ' لحساب الأصناف الراكدة


  For Each C In ShArr
    On Error Resume Next
    Set ws = ThisWorkbook.Sheets(C)
    On Error GoTo 0

    If ws Is Nothing Then MsgBox "خطأ في الوصول إلى الورقة: " & C, vbCritical: Exit Sub
    Application.ScreenUpdating = False
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    For i = 2 To lastRow
      item = ws.Cells(i, 1).Value
      item_Name = ws.Cells(i, 2).Value
      Store = ws.Cells(i, 4).Value
      Movement = ws.Cells(i, 3).Value

      If item <> "" And Store <> "" Then
        If IsDate(Movement) Then
          ' Check for both stagnant and moving items based on the period
          If DateDiff("d", Movement, Date) > stagnantPeriod Then
            ' Stagnant item
            If Not d.Exists(Store) Then d.Add Store, New Collection
            If Not n(d(Store), item) Then d(Store).Add item
            If Not KyStagnant.Exists(Store) Then KyStagnant.Add Store, 0
            KyStagnant(Store) = KyStagnant(Store) + 1
        Else            ' Moving item within the period
            If Not d.Exists(Store) Then d.Add Store, New Collection
            If Not n(d(Store), item) Then d(Store).Add item
            Ky(Store) = Ky(Store) + 1 ' Count moving items for the store
          End If
        End If
      End If
    Next i
  Next C

  On Error Resume Next: Set dest = Worksheets("مقارنة الاصناف"): On Error GoTo 0
  If dest Is Nothing Then
    Set dest = Worksheets.Add: dest.Name = "مقارنة الاصناف"
  Else
    dest.Cells.ClearContents
  End If

  ' Create headers for stagnant and moving items
  dest.[A1].Resize(1, 3) = Array("المخزن", "عدد الأصناف الراكدة", "عدد الأصناف المتحركة")
  Irow = 2
On Error Resume Next
   For Each cate In Ky.Keys
    dest.Cells(Irow, 1).Value = cate
    ' Check if there are stagnant items for this store
    If KyStagnant.Exists(cate) Then
      dest.Cells(Irow, 2).Value = KyStagnant(cate) ' عدد الأصناف الراكدة
    End If
    dest.Cells(Irow, 3).Value = Ky(cate) ' عدد الأصناف المتحركة
    Irow = Irow + 1
  Next cate

  Application.ScreenUpdating = True
End Sub

 

[عبدللرحيم]

مرفق مقترح المقارنة كميات وأصناف بكل مخزن وبها ملاحظات

 

الاصناف الراكدة لكل مخزن(6).xlsm

تم تعديل يناير 22 بواسطه عبدللرحيم
تعديل حرف