فصل البيان

[ابوعبدالواجد]

السلام عليكم - حياكم الله

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

المطلوب : فصل البيان ( اسم المادة في عمود ، والعدد في عمود ، وسعر القطعة في عمود

وكما مبين بالملف المرفق والنتائج المطلوبة

جزيتم خير - وسلمكم الله من مكروه - وتقبل الله منكم 

 

 

فرز البيان = اسم المادة - عدد القطع - سعر القطعة الواحدة - 1.rar

[ياسر خليل أبو البراء]

وعليكم السلام أخي الكريم

جرب الملف التالي .. ستجد ورقة عمل منفصلة بالنتائج .. إذا قمت بعمل تغيير في ورقة البيانات .. عليك أن تذهب لورقة النتائج وتعمل كليك يمين ثم Refresh لتحديث النتائج

فرز البيان = اسم المادة - عدد القطع - سعر القطعة الواحدة - 1.rar

[ابوعبدالواجد]

السلام عليكم - جزيت خيرا

أحمد الله اليك واشكرك استاذ ياسر

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

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

تسلم

تشكر

 

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

 بعد اذن اخي ابو البراء بالمعادلات:

في B2 ,اسحب نزولاً

=LEFT(TRIM(A2),FIND("(",TRIM(A2))-1)

في D2  اسحب نزولاً

=SUBSTITUTE(MID(TRIM(A2),(FIND("*",TRIM(A2))),((FIND("سعر",TRIM(A2)))-(FIND("*",TRIM(A2)))-1)),"*","")+0

 

[ياسر خليل أبو البراء]

بارك الله فيك أخي العزيز سليم

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

من ناحية أخرى يوجد خلل في كلا الحلين حيث أن هناك أخطاء في الصفوف من 303 إلى 316 في الحل الذي قدمته بالـ Power Query وبالحل الذي قدمته أخي سليم بالمعادلات

لذا قمت بعمل كود يعالج الأمر .. والرجاء من الأخ الكريم أبو عبد الواجد إنه يصحصح ويشوف النتائج كويس .. مش سلق بيض هو :)

إليك الكود التالي عله يفي بالغرض ويصحح الأخطاء

Sub Test()
    Dim a   As Variant
    Dim b   As Variant
    Dim s   As String
    Dim i   As Long

    a = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim b(1 To UBound(a, 1), 1 To 3)

    For i = LBound(a, 1) To UBound(a, 1)
        s = CStr(a(i, 1))
        b(i, 1) = Trim(Mid(s, 1, InStr(s, "(") - 1))
        b(i, 2) = NumByStr(s, "قطعة")
        b(i, 3) = NumByStr(s, "سعر")
    Next i

    Range("B2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

Function NumByStr(strLong As String, strShort As String) As Variant
    Dim e   As Long
    Dim s   As Long
    
    e = InStr(1, strLong, strShort, vbTextCompare)
    If e <= 1 Then
        NumByStr = ""
        Exit Function
    End If
    Do Until IsNumeric(Mid(strLong, e, 1)) Or Mid(strLong, e, 1) = "." Or Mid(strLong, e, 1) = ","
        e = e - 1
        If e = 0 Then
            NumByStr = ""
            Exit Function
        End If
    Loop
    s = e
    Do While IsNumeric(Mid(strLong, s, 1)) Or Mid(strLong, s, 1) = "." Or Mid(strLong, s, 1) = ","
        s = s - 1
        If s = 0 Then Exit Do
    Loop
    NumByStr = Mid(strLong, s + 1, e - s)
End Function

 

[ابوعبدالواجد]

السلام عليكم - شفت لا والله مو سلق بيض - علم -  والكود شغال  100 %

نساله تعالى ان يوفق وفي ميزان حسناتك

الله يرضى عليك

 

 

[ياسر خليل أبو البراء]

بارك الله فيك أخي أبو عبد الواجد وجزيت خيراً على دعائك الطيب ، ولك بمثله إن شاء العلى القدير