• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Bitişik yazılı ad ve soyadı ayırma

Katılım
11 Ekim 2006
Mesajlar
59
Excel Vers. ve Dili
Excel 2010
İyi günler,

Elimde adı ve soyadı bitişik uzun bir listem var. Adı ve soyadı ismin ilk harfleri büyük ve bitişik olarak yazılı olan örneğin ReşatKoç ismini Reşat Koç olarak yazmak istiyorum. Şimdiden teşekkürler.
 
Merhaba,

KTF ile alternatif..

C++:
Option Explicit

Function SPLIT_TEXT(ByVal Rng As Range, No As Long) As String
    Dim Matches As Object
   
    With VBA.CreateObject("VBScript.RegExp")
        .Global = True
        .IgnoreCase = False
        .Pattern = "[A-ZÇĞİÖŞÜ][a-zçğıöşü]*"
       
        Set Matches = .Execute(Rng.Text)

        If Matches.Count = 0 Then
            SPLIT_TEXT = CVErr(xlErrNA)
            Exit Function
        End If
   
        If No >= 1 And No <= Matches.Count Then
            SPLIT_TEXT = Matches(No - 1).Value
        End If
    End With
End Function

Fonksiyon kodlarını boş bir modüle uyguladıktan sonra;

Örnek olarak A1 hücresinde ReşatKoç yazıyor olsun.

C1 hücresine aşağıdaki gibi uygulayıp alta doğru sürükleyiniz..

=SPLIT_TEXT(A$1;SATIR())

Harici Link (Silinebilir) ; https://www.transfernow.net/dl/20260805mBBJc0jr
 

Ekli dosyalar

Sayın Korhan Ayhan İlginiz için çok teşekkür ederim. Hata verdi
 
Sayın Korhan Ayhan İlginiz için çok teşekkür ederim. Hata verdi
 
Alternatif :
Kod:
Function adsoyad_ayır(metin As String) As String
Dim j As Integer
Dim karakter As String
If Len(metin) < 2 Then
adsoyad_ayır = metin
Exit Function
End If
For j = 2 To Len(metin)
karakter = Mid(metin, j, 1)
If karakter Like "[A-ZĞÜŞİÖÇ]" Then
adsoyad_ayır = Left(metin, j - 1) & " " & Mid(metin, j)
Exit Function
End If
Next j
adsoyad_ayır = metin
End Function
 
Son düzenleme:
Merhaba,

Fonksiyonun çalıştığını gösteren örnek dosyayı paylaştım. İndirip deneyebilirsiniz.
 
Alternatif KTF
Kod:
Function AyirIsim(isim As String) As String
    Dim Bak As Integer
    For Bak = 2 To Len(isim)
        If Mid(isim, Bak, 1) Like "[A-ZÇĞİÖŞÜ]" Then
            AyirIsim = Left(isim, Bak - 1) & " " & Mid(isim, Bak)
            Exit Function
        End If
    Next
    AyirIsim = isim
End Function
 
Bu şekilde bir deneyin!
Kod:
Function adsoyad_ayır(metin As String) As String
Dim j As Long
Dim karakter As String
Dim sonuc As String
If Len(metin) < 2 Then
adsoyad_ayır = metin
Exit Function
End If
sonuc = Left(metin, 1)
For j = 2 To Len(metin)
karakter = Mid(metin, j, 1)
If karakter Like "[A-ZĞÜŞİÖÇ]" Then
sonuc = sonuc & " " & karakter
Else
sonuc = sonuc & karakter
End If
Next j
adsoyad_ayır = sonuc
End Function
 
Seyit Hocam iki isim için tamam. Üç isim olursa nasıl yapılır. Örneğin: MehmetZekiDoğan
Aşağıdaki kodu deneyiniz.
Kod:
Function AyirIsimler(isim As String) As String
    Dim Bak As Integer
    Dim Sonuc As String
    Sonuc = Left(isim, 1)
    For Bak = 2 To Len(isim)
        If Mid(isim, Bak, 1) Like "[A-ZÇĞİÖŞÜ]" Then
            Sonuc = Sonuc & " " & Mid(isim, Bak, 1)
        Else
            Sonuc = Sonuc & Mid(isim, Bak, 1)
        End If
    Next
    AyirIsimler = Sonuc
End Function
 
Bu şekilde bir deneyin!
Kod:
Function adsoyad_ayır(metin As String) As String
Dim j As Long
Dim karakter As String
Dim sonuc As String
If Len(metin) < 2 Then
adsoyad_ayır = metin
Exit Function
End If
sonuc = Left(metin, 1)
For j = 2 To Len(metin)
karakter = Mid(metin, j, 1)
If karakter Like "[A-ZĞÜŞİÖÇ]" Then
sonuc = sonuc & " " & karakter
Else
sonuc = sonuc & karakter
End If
Next j
adsoyad_ayır = sonuc
End Function
Evet hocam üç isim olduğunda da doğru çalışıyor. Formülle ile nasıl olur
 
Aşağıdaki kodu deneyiniz.
Kod:
Function AyirIsimler(isim As String) As String
    Dim Bak As Integer
    Dim Sonuc As String
    Sonuc = Left(isim, 1)
    For Bak = 2 To Len(isim)
        If Mid(isim, Bak, 1) Like "[A-ZÇĞİÖŞÜ]" Then
            Sonuc = Sonuc & " " & Mid(isim, Bak, 1)
        Else
            Sonuc = Sonuc & Mid(isim, Bak, 1)
        End If
    Next
    AyirIsimler = Sonuc
End Function
Hocam sizi KTF da doğru çalışıyor
 
Bu şekilde bir deneyin!
1785939515858.png
 

Ekli dosyalar

Geri
Üst