اذهب الي المحتوي
أوفيسنا

مساعدة : تحديد اخر سعر لصنف معين


zezonew

الردود الموصى بها

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

أرجو المساعدة من اساتذتنا الكرام  في تحديد اخر سعر لصنف معين 

يوجد الملف بالمرفقات 

توضيح للطلب :

1 - يوجد شيت BUY  وهو الشيت الذي يتم وضع اذون الوارد به حيث يتم وضع كل اذن في ROW واحد  مكون من 27 صنف بمشتملاته

buy.png

 

2 - يوجد شيت STORE  و به الاصناف الموجودة بالمخزن 

 

store.png

3 - المطلوب هو ((  المعادلة )) التي تقوم بوضع اخر بيانات تم وضعها في شيت BUY  الي الاماكن المحددة لها في شيت STORE

حيث اني جربت الكود الذي يقوم بنفس المهمة (( قد تفضل علي بهذا الكود الاستاذ زيزو العجوز جزاه الله خيرا ))ولكنه يستغرق وقت كبير جدا جدا للقيام بالمهمة المطلوبة حيث ان البيانات حجمها كبير وبالتالي ياخذ وقت كبير في عملية البحث 

واليكم الملف المرفق

 

help1.rar

رابط هذا التعليق
شارك

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

جرب الكود التالي
 

Sub Test()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim arr     As Variant
    Dim str     As String
    Dim x       As Long
    Dim i       As Long
    Dim j       As Long

    Set ws = Sheets("BUY")
    Set sh = Sheets("STORE")
    arr = ws.Range("E2:FJ" & ws.Cells(Rows.Count, 5).End(xlUp).Row).Value

    Application.ScreenUpdating = False
        For x = 2 To sh.Cells(Rows.Count, 1).End(xlUp).Row
            str = sh.Cells(x, 1).Value
            For i = UBound(arr, 1) To LBound(arr, 1) Step -1
                For j = UBound(arr, 2) - 5 To LBound(arr, 2) Step -6
                    If arr(i, j) <> "" And arr(i, j) = str Then
                        sh.Cells(x, 6).Value = arr(i, j + 1)
                        sh.Cells(x, 7).Value = arr(i, j + 2)
                        sh.Cells(x, 8).Value = arr(i, j + 3)
                        sh.Cells(x, 10).Value = arr(i, j + 4)
                        sh.Cells(x, 9).Value = arr(i, j + 5)
                        GoTo Skipper
                    End If
                Next j
            Next i
Skipper:
        Next x
    Application.ScreenUpdating = True
End Sub

 

  • Like 2
رابط هذا التعليق
شارك

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

تم تعديل بواسطه ابوحمزه المصرى
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information