Kelime ayırma (ad soyad) ayırma farklı formatta istiyorum

[osman1309]

slm sitede ad soyad ayırmayı buldum fakat benim istediğim format farklı bir türlü yapamadım yardımcı olabilirmiisniz.Excel dosyası ekte sunulmuştur.

Formul olarak yapıyorum benim istediğim direk makro ile yapmak

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

1. Alternatif; (Bu sizin örnek dosyanıza göre sonuç veriyor.)

Sub AD_SOYAD_AYIR_1()
    Dim X As Long, AYIR() As String
    
    Columns("B:C").ClearContents
    
    For X = 1 To Cells(65536, 1).End(xlUp).Row
        AYIR = Split(Cells(X, 1), " ")
        
        If UBound(AYIR) = 0 Then
            Cells(X, 2) = AYIR(0)
        ElseIf UBound(AYIR) = 1 Then
            Cells(X, 2) = AYIR(0)
            Cells(X, 3) = AYIR(1)
        ElseIf UBound(AYIR) > 1 Then
            Cells(X, 2) = AYIR(0) & " " & AYIR(1)
            Cells(X, 3) = Replace(Cells(X, 1), Cells(X, 2) & " ", "")
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

2. Alternatif; (Bu kod normal yazım düzenine göre ad-soyad ayırmaktadır.)

Sub AD_SOYAD_AYIR_2()
    Dim X As Long, Y As Integer, AYIR() As String
    
    Columns("B:C").ClearContents
    
    For X = 1 To Cells(65536, 1).End(xlUp).Row
        AYIR = Split(Cells(X, 1), " ")
        
        If UBound(AYIR) = 0 Then
            Cells(X, 2) = AYIR(0)
        ElseIf UBound(AYIR) = 1 Then
            Cells(X, 2) = AYIR(0)
            Cells(X, 3) = AYIR(1)
        ElseIf UBound(AYIR) > 1 Then
            
        For Y = 0 To UBound(AYIR) - 1
            Cells(X, 2) = IIf(Cells(X, 2) = Empty, AYIR(Y), Cells(X, 2) & " " & AYIR(Y))
        Next
            
            Cells(X, 3) = Replace(Cells(X, 1), Cells(X, 2) & " ", "")
        
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[osman1309]

Cok cok tesekkurlerımı sunuyorum

Sagolasın Allah razı olsun senden.

 

[osman1309]

Harflere gore baz allındıgından yanlıs sonuc verıyor

Merhaba metin=a b c d den kasıt hepsi bir kelime anlamında harfe göre yaptığınızdan bu metni ad:a b soyad=bc ayırıyor fakat ısım olarak dusununce
metın=osman mehmet tanrıverdi>>>ad=osm soyad=man mehmet tanrıverdi diye ayırıyor.

Sizden ricam musait olursanın yapabilirmisiniz.

 

[Orion1]

Ekli dosyayı inceleyiniz.

Sub ad_soyad_ayir()
Range("B2:C65536").ClearContents
For i = 2 To Cells(65536, 1).End(xlUp).Row
    a = Split(Cells(i, 1), " ")
    deg = "":                deg2 = ""

    If UBound(a) = 0 Then
        Cells(i, "B").Value = Cells(i, "A").Value
    ElseIf UBound(a) = 1 Then
        Cells(i, "B").Value = a(0)
        Cells(i, "C").Value = a(1)
        Else
        For k = 0 To UBound(a)
            If k <= 1 Then
                deg = deg & " " & a(k)
                Cells(i, "B").Value = Right(deg, Len(deg) - 1)
                Else
                deg2 = deg2 & " " & a(k)
                Cells(i, "C").Value = Right(deg2, Len(deg2) - 1)
            End If
        Next k
    End If

Next
MsgBox "İşlem Tamamdır."
End Sub

 

[Korhan Ayhan]

Selamlar,

Üstteki mesajımdaki kodu revize ettim. İncelermisiniz. İki alternatif kod önerdim. Hangisi işinize yarıyorsa onu kullanabilirsiniz.

 

[kontto]

lütfen bana yardım edin. excel de sayfa1 A1 hüresine yazdığım her kelime sayfa2 A1 hüresine, ancak yine sayfa1 A1 hüresine yazdığım kelime sayfa2 A2 hücresine yazılsın Mesela: Sayfa1 A1 hücresine Hasan Yazdım, Sayfa2 A1 hücresine Hasan yazsın fakat ben yine Sayfa1 A1 hücresine Veli yazdığım zaman ise Sayfa2 A1 de hasan vardı bunuda Sayfa2 A2 hüresine yazsın ve bunun gibi devam etsin.

 

[Korhan Ayhan]

Selamlar,

Sn. kontto,

Lütfen alakasız başlıklar altında sorularınızı sormayın. Arama yaparken problem yaşanıyor. Ayrı bir başlık açarak sorunuzu tekrar sorunuz.

 

[unur]

Selamlar,

Aşağıdaki kodu denermisiniz.

1. Alternatif; (Bu sizin örnek dosyanıza göre sonuç veriyor.)

Sub AD_SOYAD_AYIR_1()
    Dim X As Long, AYIR() As String
    
    Columns("B:C").ClearContents
    
    For X = 1 To Cells(65536, 1).End(xlUp).Row
        AYIR = Split(Cells(X, 1), " ")
        
        If UBound(AYIR) = 0 Then
            Cells(X, 2) = AYIR(0)
        ElseIf UBound(AYIR) = 1 Then
            Cells(X, 2) = AYIR(0)
            Cells(X, 3) = AYIR(1)
        ElseIf UBound(AYIR) > 1 Then
            Cells(X, 2) = AYIR(0) & " " & AYIR(1)
            Cells(X, 3) = Replace(Cells(X, 1), Cells(X, 2) & " ", "")
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Merhaba;
Yukarıdaki kodlarda ad soyadın A sütununda olduğu varsayılmış. Deneme yanılma yaptım ama beceremedim. Ad soyadı C sütununda olduğunu düşünürsek, Kodlarda nereleri değiştirmemiz gerekir. Yardımcı olabilirseniz sevinirim. Teşekkürler.

 

[unur]

Güncellemek için

 

[Korhan Ayhan]

Deneyiniz.

Kodların yanına açıklama yazdım. Sütun harflerini belirttim. Kendinizi geliştirmek istiyorsanız temel konuları öğrenmeniz gerekiyor.

Sub AD_SOYAD_AYIR_1()
    Dim X As Long, AYIR() As String
    
    Columns("D:E").ClearContents 'Ad-Soyad bilgilerinin aktarılacağı alan
    
    For X = 1 To Cells(65536, "C").End(xlUp).Row
        AYIR = Split(Cells(X, "C"), " ")
        
        If UBound(AYIR) = 0 Then
            Cells(X, "D") = AYIR(0)
        ElseIf UBound(AYIR) = 1 Then
            Cells(X, "D") = AYIR(0)
            Cells(X, "E") = AYIR(1)
        ElseIf UBound(AYIR) > 1 Then
            Cells(X, "D") = AYIR(0) & " " & AYIR(1)
            Cells(X, "E") = Replace(Cells(X, "C"), Cells(X, "D") & " ", "")
        End If
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[YUSUF44]

AYIR = Split(Cells(X, 1), " ")

satırındaki X satır numarasını, 1 ise 1. sütunu yani A sütununu ifade ediyor.

Aynı şekilde

Cells(X, 2) = AYIR(0)

ifadesindeki X yine satır numarasını, 2 ise 2. sütunu yani B sütununu işaret ediyor. Bu durumda Cells(X, 3) ifadesindeki 3'ün de C sütununu işaret ettiğini anlamışsınızdır.