Hücre içinden Parça alma

[Saladin]

Merhaba,

Aşağıda bulunan satırlar gibi bir çok data bulunmaktraıdr ve bu dataların içinde vergi numaraları ve tc kimlik numaraları da bulunmaktadır cümlenin içinden 10 haneden oluşan vergi numaralarını ve 11 haneden olusan kımlık numaralarını alabileceğim bir formüle ihtiyaç duymaktayım. desteğiniz için teşekkür ederim.

SALADIN KUCUK 1234567890 TR451236547856987456325478

SALADIN KUCUK 12345678901 TR451236547856987456325478

 

[okan32]

Merhaba,

Aşağıda bulunan satırlar gibi bir çok data bulunmaktraıdr ve bu dataların içinde vergi numaraları ve tc kimlik numaraları da bulunmaktadır cümlenin içinden 10 haneden oluşan vergi numaralarını ve 11 haneden olusan kımlık numaralarını alabileceğim bir formüle ihtiyaç duymaktayım. desteğiniz için teşekkür ederim.

SALADIN KUCUK 1234567890 TR451236547856987456325478

SALADIN KUCUK 12345678901 TR451236547856987456325478

Sub KimlikVeIbanNumaralari()
    Dim cell As Range
    Dim text As String
        Dim kimlikNumarasi As String
    Dim ibanNumarasi As String
        Dim kimlikSutun As Range
    Dim ibanSutun As Range
         
    Set kimlikSutun = Range("C1")
    Set ibanSutun = Range("D1")
   
    For Each cell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)
        text = cell.Value
       
        kimlikNumarasi = ""
        ibanNumarasi = ""
                   
        For i = 1 To Len(text) - 10
            If IsNumeric(Mid(text, i, 11)) And Len(Mid(text, i, 11)) = 11 Then
                kimlikNumarasi = Mid(text, i, 11)
                Exit For
            End If
        Next i
               
        For i = 1 To Len(text) - 25
            If Mid(text, i, 2) = "TR" And Len(Mid(text, i, 26)) = 26 Then
                ibanNumarasi = Mid(text, i, 26)
                Exit For
            End If
        Next i
                   
        If kimlikNumarasi <> "" Then
            kimlikSutun.Value = kimlikNumarasi
            Set kimlikSutun = kimlikSutun.Offset(1, 0)
        End If
       
        If ibanNumarasi <> "" Then
            ibanSutun.Value = ibanNumarasi
            Set ibanSutun = ibanSutun.Offset(1, 0)
        End If
    Next cell
End Sub

Kodu Deneyiniz..

 

[Saladin]

öncelikle ilgilne teşekkür ederim. Kodu kaydettim ama cümle içine kımlık yada vergi numarası yoksa gidip bunun ıban numarasından alıyor

 

[walabi]

Makro kullanarak çözmek isterseniz,

Yenibir fonksiyon oluşturarak tüm excel dosyalarınızda kullanabilirsiniz.

Örneğin A1 hücresinde veriniz var. B1 hücresine şu formülü yazın

=Metin_Ayır(A1;1;" ")
=Metin_Ayır(A1;2;" ")
=Metin_Ayır(A1;3;" ")
=Metin_Ayır(A1;4;" ")

Formül içindeki sayı boşluk karakterinden önce alınacak veri sütunun ifade eder.

SALADIN KUCUK 1234567890 TR451236547856987456325478

SALADIN

KUCUK

1234567890

TR451236547856987456325478

Function Metin_Ayır(Txt, n, Ayırıcı) As String

    Dim Txt1 As String, temperament As String
    Dim Elemansayısı As Integer, i As Integer
    Dim Karekter As String
        Txt1 = Txt
    If Ayırıcı = Chr(32) Then Txt1 = Application.Trim(Txt1)
        If Right(Txt1, Len(Txt1)) <> Ayırıcı Then _
        Txt1 = Txt1 & Ayırıcı
        Elemansayısı = 0
    Karekter = ""
        For i = 1 To Len(Txt1)
        If Mid(Txt1, i, 1) = Ayırıcı Then
            Elemansayısı = Elemansayısı + 1
            If Elemansayısı = n Then

                Metin_Ayır = Karekter
                Exit Function
            Else
                Karekter = ""
            End If
        Else
            Karekter = Karekter & Mid(Txt1, i, 1)
        End If
    Next i
    Metin_Ayır = ""
End Function

 

[okan32]

öncelikle ilgilne teşekkür ederim. Kodu kaydettim ama cümle içine kımlık yada vergi numarası yoksa gidip bunun ıban numarasından alıyor

Sub KimlikVeIbanNumaralari()

    Dim cell As Range

    Dim text As String

    Dim kimlikNumarasi As String

    Dim ibanNumarasi As String

    Dim kimlikSutun As Range

    Dim ibanSutun As Range
    

    Set kimlikSutun = Range("C1")

    Set ibanSutun = Range("D1")
 

    For Each cell In Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row)

        text = cell.Value

      

        kimlikNumarasi = ""

        ibanNumarasi = ""
              

      

        For i = 1 To Len(text) - 10

            If IsNumeric(Mid(text, i, 11)) And Len(Mid(text, i, 11)) = 11 Then

                kimlikNumarasi = Mid(text, i, 11)

                Exit For

            End If

        Next i
          

      

        For i = 1 To Len(text) - 25

            If Mid(text, i, 2) = "TR" And Len(Mid(text, i, 26)) = 26 Then

                ibanNumarasi = Mid(text, i, 26)

                Exit For

            End If

        Next i

                  

      

        If kimlikNumarasi <> "" Then

            kimlikSutun.Value = kimlikNumarasi

        Else

            kimlikSutun.Value = ""

        End If

        Set kimlikSutun = kimlikSutun.Offset(1, 0)

      

    

        If ibanNumarasi <> "" Then

            ibanSutun.Value = ibanNumarasi

        Else

            ibanSutun.Value = ""

        End If

        Set ibanSutun = ibanSutun.Offset(1, 0)

    Next cell

End Sub

 

[ÖmerBey]

Merhaba,
Deneyiniz...

=TCyadaVergi(A1)

Function TCyadaVergi(hcr As Range) As String
    Dim reg As Object, m As Object
   
    Set reg = CreateObject("VBScript.Regexp")
    reg.Pattern = "\b\d{10,11}\b"
    Set m = reg.Execute(hcr)
    If Not m Is Nothing Then TCyadaVergi = m(0)
End Function

 

[walabi]

Syn Ömerbey bu fonksiyonu aşağıda belirteceğim maddeler için ayrı ayrı kullanmak istersek sonuç verici bir fonksiyona dönüştürmek mümkün olur mu?

İban No : 26 haneli bir metin parçası. TR ile başlar. Geri kalan 24 hane sayı (Karakterler arasında boşluk olmadığını varsayarak).
Tarih : GG.AA.YYYY formatında metin içinde yer alan metin parçası
Plaka : 34 AA 3434 formatıyla ya da 34AA3434 formatıyla metin içinde yer alan parça.

Yazdığınız fonksiyonu bu 3 konu için uyarlamak mümkün müdür?

 

[pitchoute]

Merhabalar,

İBAN için;

Function ExtractIBAN(hcr As Range) As String
    Dim reg As Object, m As Object
    
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "TR\d{24}"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then ExtractIBAN = m(0)
End Function

Kullanım; =ExtractIBAN(A1)

TARİH için;

Function ExtractDate(hcr As Range) As String
    Dim reg As Object, m As Object
    
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "\b\d{2}\.\d{2}\.\d{4}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then ExtractDate = m(0)
End Function

Kullanım; =ExtractDate(A1)

PLAKA için;

Function ExtractPlaka(hcr As Range) As String
    Dim reg As Object, m As Object
    
    Set reg = CreateObject("VBScript.RegExp")
    reg.Pattern = "\b\d{2}\s?[A-Za-z]{1,3}\s?\d{2,4}\b"
    Set m = reg.Execute(hcr.Value)
    If m.Count > 0 Then ExtractPlaka = m(0)
End Function

Kullanım; =ExtractPlaka(A1)

 

[walabi]

Cevaplar için teşekkürler. Bunlar muhasebe ve finans birimlerine yerine göre çok gerekli olabiliyor. Bu şekilde fonksiyon yapısını ilk defa bugün görmüş oldum.

 

[pitchoute]

Rica ederim, iyi çalışmalar.

 

[Korhan Ayhan]

Cevaplar için teşekkürler. Bunlar muhasebe ve finans birimlerine yerine göre çok gerekli olabiliyor. Bu şekilde fonksiyon yapısını ilk defa bugün görmüş oldum.

Aslında forumda konuyla ilgili bolca işlenmiş konu var. Sanırım daha önce dikkatinizi çekmedi..

Sorgu için arama sonuçları: RegExp

www.excel.web.tr