zezonew قام بنشر يناير 19, 2017 مشاركة قام بنشر يناير 19, 2017 السلم عليكم ورحمة الله وبركاته أرجو المساعدة من اساتذتنا الكرام في تحديد اخر سعر لصنف معين يوجد الملف بالمرفقات توضيح للطلب : 1 - يوجد شيت BUY وهو الشيت الذي يتم وضع اذون الوارد به حيث يتم وضع كل اذن في ROW واحد مكون من 27 صنف بمشتملاته 2 - يوجد شيت STORE و به الاصناف الموجودة بالمخزن 3 - المطلوب هو (( المعادلة )) التي تقوم بوضع اخر بيانات تم وضعها في شيت BUY الي الاماكن المحددة لها في شيت STORE حيث اني جربت الكود الذي يقوم بنفس المهمة (( قد تفضل علي بهذا الكود الاستاذ زيزو العجوز جزاه الله خيرا ))ولكنه يستغرق وقت كبير جدا جدا للقيام بالمهمة المطلوبة حيث ان البيانات حجمها كبير وبالتالي ياخذ وقت كبير في عملية البحث واليكم الملف المرفق help1.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 19, 2017 مشاركة قام بنشر يناير 19, 2017 وعليكم السلام جرب الكود التالي 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 2 رابط هذا التعليق شارك More sharing options...
zezonew قام بنشر يناير 19, 2017 الكاتب مشاركة قام بنشر يناير 19, 2017 ماشاء الله عليك يا استاذنا الغالي ابو البراء الكود قام بالمطلوب و بسرعة جزاك الله خيرا 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 19, 2017 مشاركة قام بنشر يناير 19, 2017 وجزيت خيراً بمثل ما دعوت لي أخي الكريم الحمد لله الذي بنعمته تتم الصالحات رابط هذا التعليق شارك More sharing options...
ابوحمزه المصرى قام بنشر يناير 19, 2017 مشاركة قام بنشر يناير 19, 2017 (معدل) ايه الحلاوه دى يا استاذنا ياابو البراء ...... انت للعباقرة عنوان والله ........ ممكن تترجم اللاونجى ده تم تعديل يناير 19, 2017 بواسطه ابوحمزه المصرى رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر يناير 19, 2017 مشاركة قام بنشر يناير 19, 2017 أي لاونجي ..الكود واضح أهو .. لو فيه حاجة مش واضحة استفسر عنها ، بس حاجة واحدة مش كل الكود رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.