هل يمكن استخراج رقم بمواصفات محددة من اكسل؟

[رحااال]

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

يوجد أرقام جوالات مبعثرة في ملف اكسل كبير

هل يوجد أمر مثلاً أقول للإكسل استخرج جميع الأرقام المكونة من 10 خانات وتبدأ بـ 05 أي رقم بهذه المواصفات يستخرجه في عمود واحد ..

وشكراً

[lionheart]

Don't post mysterious questions. Be specific and attach file with the desired results

[رحااال]

السؤال واضح أخي الكريم

 

ملف يحتوي على بيانات من ضمنها أرقام جوالات ..

أريد الاكسل يستخرج جميع الارقام التي تحتوي على 10 خانات وبدايتها 05

التي هي ارقام الجوالات

 

وشكراً لك جزيلاً .

[lionheart]

I have no time to create a file to test on it

Please attach sample file if you really need help

[حسونة حسين]

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

لطفا ارفق ملف 

[محي الدين ابو البشر]

السلام عليكم 

بالإذن منكم باعتبار لا يوجد ملف مرفق

إذا كانت الداتا في Sheet1 ,وتبدأ من A1

والنتيجة في sheet2  العمود A1 down

Sub test()
    Dim cel As Range
    Dim i&
    With CreateObject("VBScript.RegExp")
        .Global = True
        For Each cel In Sheets("sheet1").UsedRange.Cells
            .Pattern = "[05 ]*[\d]{8}"
            If .test(cel) Then
                Sheets("sheet2").Cells(i + 1, 1) = .Execute(cel)(0)
                i = i + 1
            End If
        Next
    End With
End Sub

 

[lionheart]

Great my bro

That is my try

Sub Test()
    Call Generate_Random_Numbers
    Call Extract_Valid_Numbers_Only
End Sub

Private Sub Generate_Random_Numbers()
    Dim i As Long
    With ActiveSheet
        With .Columns("A:B")
            .ClearContents: .NumberFormat = "@": .ColumnWidth = 20
        End With
        .Range("A1").Resize(, 2).Value = Array("Numbers", "Result")
        ReDim a(1 To 100, 1 To 1)
        For i = LBound(a) To UBound(a, 1)
            a(i, 1) = GenerateNumber()
        Next i
        .Range("A2").Resize(UBound(a, 1), UBound(a, 2)).Value = a
    End With
End Sub

Function GenerateNumber() As String
    Dim a, sRanNum As String, sPrefix As String, iLen As Long
    a = Array("02", "05")
    iLen = WorksheetFunction.RandBetween(8, 11)
    sPrefix = a(WorksheetFunction.RandBetween(0, UBound(a)))
    sRanNum = sPrefix & Format(Application.WorksheetFunction.RandBetween(10 ^ (iLen - 3), (10 ^ (iLen - 2)) - 1), String(iLen - 2, "0"))
    GenerateNumber = sRanNum
End Function

Private Sub Extract_Valid_Numbers_Only()
    Dim a, ws As Worksheet, n As Long, i As Long
    Set ws = ActiveSheet
    a = ws.UsedRange.Columns(1).Value
    ReDim b(1 To UBound(a, 1), 1 To 1)
    n = 1
    With CreateObject("VBScript.RegExp")
        .Global = True
        For i = 1 To UBound(a, 1)
            .Pattern = "^05\d{8}$"
            If .Test(a(i, 1)) Then
                b(n, 1) = .Execute(a(i, 1))(0).Value
                n = n + 1
            End If
        Next i
    End With
    ws.Range("B2").Resize(UBound(b, 1), UBound(b, 2)).Value = b
End Sub

 

There are two codes: the first code will generate random numbers and the second code will extract the valid numbers only