saad abed قام بنشر أكتوبر 27, 2019 مشاركة قام بنشر أكتوبر 27, 2019 اخوانى الاعزاء ارفقت مثال يشابه الملف الاصلى فى الفكره فمشكلتى ان الاسعار متغيره فاريد الحصول على اخر سعر من اسعار متعدده كتب بينهم فاصل "-" فهل ممكن الحصول على اخر سعر بهذه الطريقه يفضل الاكواد من فضلك لا تقوم برفع ملف مضغوط طالما حجم الملف صغير ,تجنبا لعدم اهدار وقت الأساتذة فى الأطلاع على الملف-وطالما انك تريد الحل بالأكواد فكان من الأسهل والأفضل رفع الملف ب Xlsm. Book1.xlsm رابط هذا التعليق شارك More sharing options...
أفضل إجابة الـعيدروس قام بنشر أكتوبر 27, 2019 أفضل إجابة مشاركة قام بنشر أكتوبر 27, 2019 السلام عليكم اسعد مساك اخي سعد عابد كيف صحتك ان شاء الله تكون بصحة وسلامه بالامكان عبر هذه المعادلة المعرفة Function Ali_Sp(D) Dim A Dim i, x, E A = Sheets("الاسعار").Range("B6:D500").Value For i = LBound(A, 1) To UBound(A, 1) If A(i, 2) = D Then E = A(i, 3) E = Split(A(i, 3), "-") x = UBound(E) Ali_Sp = E(x) Exit For End If Next i End Function او عبر هذا الكود Sub Ali_S() Dim A Dim x, i, E, R A = Sheets("الاسعار").Range("B6:D500").Value For i = LBound(A, 1) To UBound(A, 1) For R = 5 To Cells(Rows.Count, "B").End(xlUp).Row If A(i, 2) = Cells(R, "B") Then E = A(i, 3): E = Split(A(i, 3), "-") x = UBound(E): Cells(R, "C") = E(x) End If Next R Next i End Sub 1 رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر أكتوبر 27, 2019 الكاتب مشاركة قام بنشر أكتوبر 27, 2019 (معدل) اخى ابونصار اشتقت لمواضيعك واكوادك ومساعداتك اكرمك الله اخى اتمنى ان تكون بخير وفى احسن حال جزاك الله خيرا جارى التجربه تم تعديل أكتوبر 27, 2019 بواسطه سعد عابد 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أكتوبر 27, 2019 مشاركة قام بنشر أكتوبر 27, 2019 بعد اذن اخي العيدروس هذه المعادلة (Ctrl+Shift+Enter) =IFERROR(--MID(D6,MAX(IF(MID(D6,ROW(INDIRECT("1:"&LEN(D6))),1)="-",ROW(INDIRECT("1:"&LEN(D6)))+1)),LEN(D6)),"") Booook1.xlsx 2 رابط هذا التعليق شارك More sharing options...
saad abed قام بنشر أكتوبر 27, 2019 الكاتب مشاركة قام بنشر أكتوبر 27, 2019 (معدل) اخى ابو نصار الكود يعمل بكفاءه كعادة اكوادك اسال الله ان يجزيك كل خير ============================= اخى سليم اشكرك على مجهودك وردودك السريعة على الاعضاء تقبل منى تحياتى واحترامى اخى العزيز اشكر لك مجهودك تم تعديل أكتوبر 27, 2019 بواسطه سعد عابد 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أكتوبر 27, 2019 مشاركة قام بنشر أكتوبر 27, 2019 اذا اردتها بواسطة الماكرو الكود Option Explicit Sub test() Dim slash$: slash = "-" Dim x%: x = 1 Dim k%: k = 6 Dim st Range("G6").CurrentRegion.ClearContents Do Until Range("D" & k) = vbNullString st = Range("D" & k) Do Until x = 0 x = InStr(st, slash) If x Then st = Replace(st, " ", 1, x + 1) Loop Range("G" & k) = st k = k + 1 x = 1 Loop End Sub 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر أكتوبر 27, 2019 مشاركة قام بنشر أكتوبر 27, 2019 اختصار بسيط للكود الوارد سابقاً Option Explicit Sub test_1() Dim slash$: slash = "-" Dim x%, k%: k = 6 Range("G6:G" & Rows.Count).ClearContents Do Until Range("D" & k) = vbNullString x = InStrRev(Range("D" & k), slash) If x Then Range("G" & k) = Replace(Range("D" & k), " ", 1, x + 1) End If k = k + 1 Loop End Sub 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان