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

[saad abed]

اخوانى الاعزاء

ارفقت مثال يشابه الملف الاصلى فى الفكره

فمشكلتى ان الاسعار متغيره

فاريد الحصول على اخر سعر من اسعار متعدده كتب بينهم فاصل "-"

فهل ممكن الحصول على اخر سعر بهذه الطريقه 

يفضل الاكواد

من فضلك لا تقوم برفع ملف مضغوط طالما حجم الملف صغير ,تجنبا لعدم اهدار وقت الأساتذة فى الأطلاع على الملف-وطالما انك تريد الحل بالأكواد فكان من الأسهل والأفضل رفع الملف ب Xlsm.

 

Book1.xlsm

[الـعيدروس]

السلام عليكم

اسعد مساك اخي سعد عابد

كيف صحتك ان شاء الله تكون بصحة وسلامه

بالامكان عبر هذه المعادلة المعرفة

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

 

 

[saad abed]

اخى ابونصار

اشتقت لمواضيعك واكوادك ومساعداتك

اكرمك الله اخى

اتمنى ان تكون بخير وفى احسن حال

جزاك الله خيرا

جارى التجربه

 

تم تعديل أكتوبر 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

[saad abed]

اخى ابو نصار

الكود يعمل بكفاءه كعادة اكوادك

اسال الله ان يجزيك كل خير

=============================

اخى سليم

اشكرك على مجهودك وردودك السريعة على الاعضاء

تقبل منى تحياتى واحترامى اخى العزيز

اشكر لك مجهودك

تم تعديل أكتوبر 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

 

[سليم حاصبيا]

اختصار بسيط للكود الوارد سابقاً

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