فصل ارقام عن حروف في خلية

[أبو أحمد]

الاخوه الكرام / أعضاء المنتدى

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

لدي ملف في جميع خلايا عمود ما يحتوي على حروف وأرقام (حرفين وأكثر من 3 أرقام) 

كيف لي أن أفصل الحروف عن الارقام وجزاكم الله خيرا 

 

[أبوبسمله]

اخى الكريم

ضع ملفك ليتم التعديل عليه من قبل اخوانك

بالتوفيق اخى

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

جرب هذا الشيء

 

extract_number.rar

[أبو أحمد]

ممكن الملف يكون على أوفيس 2003 

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

Book1.rar

[أبوبسمله]

اتفضل اخى

جزاك الله كل خير اخى سليم

نفس المثال اخى سليم قمت بتحويله لك2003

بالتوفيق

extract_number-2003.rar

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

17 دقائق مضت, adsabbah said:

ممكن الملف يكون على أوفيس 2003 

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

Book1.rar

تفضل اخي على 2003 (عفواً اخي احمد لم انتبه الى مشاركتك)

extract_text_number.rar

تم تعديل فبراير 18, 2016 بواسطه سليم حاصبيا

[أبو أحمد]

أستاذي الكريم 

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

ولكن لماذا حذف العلامة العشرية من الأرقام وأضافها في الحروف

450.45 ع. ب

جعلها 45045

 .ع. ب

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

أخي الكريم صاحب الموضوع

يرجى تغيير اسم الظهور للغة العربية ليعبر عن شخصكم الكريم

 

جرب المعادلة التالية في الخلية B2

=TRIM(IF(A2<>"",RIGHT(SUBSTITUTE(A2," ","!",LEN(A2)-LEN(SUBSTITUTE(A2," ", ""))),LEN(SUBSTITUTE(A2," ","!",LEN(A2)-LEN(SUBSTITUTE(A2," ", ""))))-FIND("!",SUBSTITUTE(A2," ","!",LEN(A2)-LEN(SUBSTITUTE(A2," ", ""))))),""))

ثم ضع المعادلة التالية في الخلية C2

=TRIM(IF(A2<>"",SUBSTITUTE(A2,B2,""),""))

إذا لم تعمل المعادلة قم باستبدال الفاصلة العادية بفاصلة منقوطة

وإليك الملف المرفق فيه تطبيق للمطلوب

 

Split Text & Numbers Using Formulas.rar

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

سيتم التعديل

تم تعديل فبراير 19, 2016 بواسطه سليم حاصبيا

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

6 ساعات مضت, adsabbah said:

أستاذي الكريم 

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

ولكن لماذا حذف العلامة العشرية من الأرقام وأضافها في الحروف

450.45 ع. ب

جعلها 45045

 .ع. ب

هذا لانك وضعت العلامة العشرية للنص كنقطة و نفس الشيء للارقام 

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

يمكتك استبدال لكود ليصبح هكذا

Sub extract_numbers()

Dim mycol As New Collection
Dim mycol1 As New Collection
Dim mytext, mytext1 As String

lr = Cells(Rows.Count, 1).End(3).Row
For i = 2 To lr
    x = Application.WorksheetFunction.Trim(Range("a" & i).Value)
    On Error Resume Next
     For t = 1 To Len(x)
        y = Mid(x, t, 1)
       
            If IsNumeric(y) Or Asc(y) = 46 Then
              mycol.Add y
              mytext = mytext & y
            Else
              mycol1.Add y
              mytext1 = mytext1 & y
            End If
    
     Next
   
        If Asc(Right((mytext), 1)) = 46 Then
             Cells(i, 2) = Left(mytext, Len(mytext) - 1)
        Else
             Cells(i, 2) = mytext
        End If

  Cells(i, 3) = Left(mytext1, Len(mytext1) - 1) & Chr(46) & Right(mytext1, 1)
    mytext = ""
    mytext1 = ""
Next
End Sub

 

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

تسلم أخي الحبيب سليم على هذا الكود الرائع ..

لو تكرمت عايزين منك شروحات للأكواد الجميلة التي تقدمها ليستفيد منها الجميع

بارك الله فيك وجزاك الله خيراً

تقبل تحياتي

 

[أبو أحمد]

جزاكم الله خيرا أستاذي الكريم

ولكن هل يمكن فصل جزء من خلية عن باقي الخلية وليكن مثلا 

الجيزه : المركز المصرى للكتاب ، 1417 هـ = 1996 م.

أريد الحصول على الجملة التي بعد النقطتين وقبل الفصلة وهي "المركز المصري للكتاب"

 حيث أن الملف يحتوي على عمود به أكثر من 2500 صف 

العمود هو E 

أريد فصل الجزء الخاص الذي بعد : وقبل الفصلة في كل خلية فهل يمكن ذالك جزاكم الله خيرا

تم تعديل فبراير 22, 2016 بواسطه adsabbah

[محمد الريفى]

اتمنى ان يفيدك هذا الموضوع

تابع التفاصيل من الرابط

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

جرب هذا الملف

 

 

MID OF TEXT.rar

[أبو أحمد]

أستاذي الكريم / 

جزاكم الله خيرا وأستئذنكم في جعل الملف على اكسل 2003 حيث هو المتوفر لدي

 

تم تعديل فبراير 22, 2016 بواسطه عادل صباح

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

لا حاجة لذلك فان المعادلة لموجودة يفهمها 2003 بسهولة

[أبو أحمد]

 أستاذي الكريم الملف لا يفتح عندي علة اكسل 2003

تم تعديل فبراير 22, 2016 بواسطه عادل صباح

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

أخي الكريم عادل

يفضل دائماً إرفاق ملف معبر عن الملف الأصلي

جرب الكود التالي عله يفي بالغرض

Sub SplitIt()
    Dim I As Long, Arr1, Arr2
    
    Application.ScreenUpdating = False
        Arr1 = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
        For I = LBound(Arr1) To UBound(Arr1)
            Cells(I, 7) = VBA.Split(Arr1(I, 1), " : ")(1)
        Next I
        
        Arr2 = Range("G1:G" & Cells(Rows.Count, 7).End(xlUp).Row).Value
        For I = LBound(Arr2) To UBound(Arr2)
            Cells(I, 2) = VBA.Split(Arr2(I, 1), " ، ")(0)
            Cells(I, 3) = VBA.Split(Arr2(I, 1), " ، ")(1)
        Next I
        
        Columns(7).ClearContents
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

Split Text YasserKhalil.rar

[أبو أحمد]

استاذي الكريم مرفق لكم مثال بسيط وجزاكم الله خيرا Insert other media

Ex.rar

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

21 دقائق مضت, عادل صباح said:

 أستاذي الكريم الملف لا يفتح عندي علة اكسل 2003

جرب هذه النسخة 2003

MID OF TEXT1.rar

[أبو أحمد]

أستاذي الكريم 

جزاكم الله خيرا وزادكم علما ونفع بكم المسلمين 

هذا هو المطلوب

 

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

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

Sub SplitIt()
    Dim I As Long, Arr1, Arr2, X
    
    Application.ScreenUpdating = False
        Arr1 = Range("E1:E" & Cells(Rows.Count, 5).End(xlUp).Row).Value
        For I = LBound(Arr1) To UBound(Arr1)
            Cells(I, 6) = Mid(VBA.Split(Arr1(I, 1), " : ")(1), 1, InStr(VBA.Split(Arr1(I, 1), " : ")(1), " ¡ ") - 1)
        Next I
    Application.ScreenUpdating = True
End Sub

 

 

Split Text YasserKhalil V2.rar

[أبوبسمله]

جزاكم الله خيرا اخى سليم واخى ابو البراء

 

[أبو أحمد]

طبعا أستاذي الكريم

شكرا أستاذي أبو براء وأستاذي سليم   

ولكن أنا أسف كنت مشغول في تجربة الكود 

وهذا سبب تأخري

كيف نجعل المثال السابق ينطبق على اللغة الإنجليزية 

بمعنى لو الجملة هكذا 

Giza : nahdet miser , 2006.

وأردت أن أحصل على جملة 

nahdet miser

فقط فكيف نحول المعادلة هذه 

IF(A3="";"";MID(LEFT(A3;FIND("،";A3)-1);FIND(":";A3)+1;500))

 

تم تعديل فبراير 22, 2016 بواسطه عادل صباح

[أبو أحمد]

أستاذي الكريم / أبو براء بارك الله فيكم

أنا لم أستطع وضع الكود الذي أرشدتني إليه فهل يمكنكم المساعدة 

علما بأن ما أريد تحويله قد يكون باللغة العربية أو باللغة الإنجليزية 

مرفق مثال للتوضيح 

Ex.rar

Ex.rar

تم تعديل فبراير 22, 2016 بواسطه عادل صباح