كيف يتم تقسيم الخلية الواحدة لأعمدة بعدة شروط

[sh0kri2]

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

لدينا عمود يتكون من ارقام هواتف

داخل الخليه توجد نصوص وايضا ارقام 

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

فكيف يتم استخراج ارقام الهواتف فقط وكل رقم في عمود جديد 

ان كانت الخليه تحتوي على رقم واحد وكلمة واحد يستخرج الرقم

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

مثال مرفق للخليه المراد تقسيمها 

 

الملف يحتوي على اكثر من 5000 خليه فقمت باقتطاع جزء منه لايصال المعلومه 

المصنف1.xlsx

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

جرب هذا الكود

ملاحظة مهمة جدا ً  المطلوب ابقاء العامود  B (فارغاً ) و الا يتم مسح كامل البيانات

Option Explicit
Sub Salim_Regex()
   If ActiveSheet.Name <> "ورقة1" Then Exit Sub
    Dim Mot As String
    Dim My_Regex        As Object
    Dim arrWords        As Variant
    Dim RA As Long, x  As Long
    Dim m As Long, Ro As Long
   
    Range("C2").CurrentRegion.ClearContents
     RA = Cells(Rows.Count, 1).End(3).Row
    
    Set My_Regex = CreateObject("VBScript.RegExp")
    My_Regex.Global = True
    My_Regex.Pattern = "([\+]?\(?\d+\)?\W\d+\W\d+)+"
 m = 3
For Ro = 2 To RA
      Mot = Cells(Ro, 1)
      If My_Regex.test(Mot) Then
          Set arrWords = My_Regex.Execute(Mot)
              For x = 0 To arrWords.Count - 1
                Cells(Ro, m) = arrWords(x)
                m = m + 1
              Next x
      End If
 m = 3
Next Ro
End Sub

الملف مرفق

 

Use_Regex.xlsm

[sh0kri2]

ماشاء الله تبارك الله ماشاء الله تبارك الله

الله يبارك فيه 

تستحق مليون لايك وقبله في جبينك 

الله يريح عليك