قائمة أرقام تليفونات مستخرجة من قاعدة بيانات

[M7md Mustafa]

السلام عليكم

جزاكم الله كل خير علي ما تقدمونه من خدمات

ارجو منكم المساعدة لدي قائمة أرقام تليفونات مستخرجة من قاعدة بيانات في العمود A اريد تجميعها في الصفوف بناءاً علي العدد الذي أقوم بادخاله في الخلية D2 مثلا يتم تجميع كل 10 ارقام من العمود A في صف واحد تحت الخانة Final ثم 10 اخرين في الصف التالي وهكذا علي ان يكون الفاصل بين الأرقام هو الموجود في الخلية C2 لان الفاصل متغير وليس ثابت فمرة يكون - ومرة يكون / ومرة يكون ,

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

PhoneList.rar

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

جرب هذا الكود

Sub extract_num()
 Dim n, lr, x, r As Integer
 Dim s As String
 s = ""
 x = 4
 r = 5
 n = 6
 lr = Cells(Rows.Count, 1).End(3).Row
 
  Do Until n > lr
          s = s & Cells(n, 1) & ";"
           n = n + 1
           x = x + 1
          If x Mod 15 = 0 Then r = r + 1: s = Cells(n - 1, 1) & ";": x = 5
   Cells(r, 3) = s
   Loop

End Sub

 

[أبو عبد النور]

بعد إذن الاخ سليم،

انظر الى المرفق.

PhoneListSep_v001.rar

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

Sub Test()
    Dim delim       As String
    Dim x           As Variant
    Dim rRow        As Integer
    Dim i           As Integer

    Application.ScreenUpdating = False
        Range("C5:C100").ClearContents
        delim = Range("C2").Value
        x = Range("D2").Value
        rRow = 5
        
        If Not IsNumeric(x) Or x = "" Then MsgBox "Enter A Number In Cell D2", vbExclamation: Exit Sub
    
        For i = 5 To Cells(Rows.Count, 1).End(xlUp).Row Step x
            With Cells(rRow, "C")
                .NumberFormat = "@"
                .Value = MultiCat(Range("A" & i).Resize(x), delim)
            End With
            rRow = rRow + 1
        Next i
    Application.ScreenUpdating = True
End Sub

Function MultiCat(ByRef rRng As Excel.Range, Optional ByVal sDelim As String = "") As String
    Dim rCell       As Range

    For Each rCell In rRng
        If Not IsEmpty(rCell) Then
            MultiCat = MultiCat & sDelim & rCell.Text
        End If
    Next rCell
    
    MultiCat = Mid(MultiCat, Len(sDelim) + 1)
End Function

 

[M7md Mustafa]

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