cep telefonu numaralarını ayırma

[nurdann]

exelde F hücresine yazılmış 1000 civarı sabit ve cep telefonu numaraları var.Sadece cep numaralarını ayırmam gerekiyor yardımcı olabilirmisiniz?

 

[Necdet]

Merhaba,

Resimden pek birşey anlaşılmıyor, basit bir kaç satır örnek olan dosya ekler misiniz?

 

[nurdann]

açılmazsa resim olarak göndereyim mi?

 

[Necdet]

Merhaba,

Cep telefonlarını ayırmaktan kastınızı pek anlamadım ama ben F sütununda cep telefonları varsa bunları K sütununa yazdırdım.

Umarım işinize yarar.

Sub CepTelAyir()
    Dim i   As Long
    Dim j   As Integer
    Dim d() As String
    Dim s1  As Worksheet
    Set s1 = Sheets("Sayfa1")
    
    s1.Select
    Application.ScreenUpdating = False
    
    For i = 2 To [B65536].End(3).Row
        d = Split(Application.WorksheetFunction.Trim(Cells(i, "F")), " ")
        For j = 0 To UBound(d)
            If d(j) Like "05*" Or d(j) Like "5*" Then
                If Len(Cells(i, "K")) = 0 Then
                    Cells(i, "K") = d(j)
                Else
                    Cells(i, "K") = Cells(i, "K") & " - " & d(j)
                End If
            End If
        Next j
    Next i
   
    Application.ScreenUpdating = True
    
    MsgBox "Cep Telefonları K Sütununa Yazılmıştır"
    
End Sub

 

[nurdann]

ayy tam istediğim gibi oldu çok teşekkür ederim elinize sağlık.

 

[Necdet]

Merhaba,

Güle güle kullanınız.