Ad Soyada göre Büyük Küçük Harf Değiştirme

[Feylosof]

İyi Akşamlar;

Dosyamda yapmak istediğim uygulamayı kısaca anlatmaya gayret ettim. Yardımcı olursanız çok memnun olurum. Selametle

 

[Mdemir63]

Selamlar
Bir Modül içine Kopyalayın.
Butona atayın

Sub AdKucukSoyadBuyuk()
SonSat = Worksheets("Sayfa1").Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To SonSat
    Ad = ""
    Soyad = ""
    a = Split(Cells(i, "A"), " ")
    For j = 0 To UBound(a) - 1
                                    
        Ad = Trim(Ad & " " & a(j))
    Next j
 
    Soyad = Trim(a(UBound(a)))
    Ad = Evaluate("=PROPER(""" & Ad & """)")
    Soyad = Evaluate("=UPPER(""" & Soyad & """)")
    Cells(i, "A") = Ad & " " & Soyad
Next i
End Sub

 

[Feylosof]

Sayın @Mdemir63 ilginiz ve yardımınız için teşekkür ederim.
Kodda şöyle bir hata söz konusu

 

[Ziynettin]

Alternatif olarak.

Sub test()
    Sheets("sayfa1").Select
    son = Cells(Rows.Count, 1).End(xlUp).Row
    a = Range("A1:A" & son).Value
    ReDim b(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        v = VBA.Trim(a(i, 1))
        s = InStrRev(v, " ")
        ad = Evaluate("=PROPER(""" & Left(v, s) & """)")
        soyad = Evaluate("=UPPER(""" & Mid(v, s + 1, Len(v)) & """)")
        b(i, 1) = ad & soyad
    Next i
    [A1].Resize(UBound(a), 2) = b
    MsgBox "İşlem tamam...", vbInformation
End Sub

 

[Korhan Ayhan]

Bende hazırlamıştım. Farklı komut kullanımından dolayı paylaşmak istedim.

Option Explicit

Sub Ad_Soyad_Yazim_Duzeni()
    Dim Son As Long, X As Long, Veri As Variant
    Dim Ad As Variant, Soyad As String, Say As Long
    
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son < 2 Then Son = 2
    
    Veri = Range("A1:A" & Son).Value
    
    ReDim Liste(1 To UBound(Veri, 1), 1 To 1)
    
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        If Veri(X, 1) <> "" Then
            Ad = Split(WorksheetFunction.Proper(Veri(X, 1)), " ")
            If UBound(Ad, 1) = 0 Then
                Liste(Say, 1) = Ad(0)
            Else
                Soyad = Ad(UBound(Ad, 1))
                ReDim Preserve Ad(0 To UBound(Ad, 1) - 1)
                Liste(Say, 1) = Join(Ad, " ") & " " & UCase(Replace(Replace(Soyad, "ı", "I"), "i", "İ"))
            End If
        End If
    Next
    
    Range("A1").Resize(UBound(Veri, 1)) = Liste
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[Mdemir63]

Sayın @Mdemir63 ilginiz ve yardımınız için teşekkür ederim.
Kodda şöyle bir hata söz konusu

Selamlar
Dosyanızda A Sütunundaki isimlerin altında yazan yazıları kaldırın sadece isim ve soy isimler olsun

 

[Feylosof]

Alternatif olarak.

Sub test()
    Sheets("sayfa1").Select
    son = Cells(Rows.Count, 1).End(xlUp).Row
    a = Range("A1:A" & son).Value
    ReDim b(1 To UBound(a), 1 To 2)
    For i = 1 To UBound(a)
        v = VBA.Trim(a(i, 1))
        s = InStrRev(v, " ")
        ad = Evaluate("=PROPER(""" & Left(v, s) & """)")
        soyad = Evaluate("=UPPER(""" & Mid(v, s + 1, Len(v)) & """)")
        b(i, 1) = ad & soyad
    Next i
    [A1].Resize(UBound(a), 2) = b
    MsgBox "İşlem tamam...", vbInformation
End Sub

Çok teşekkür ederim üstadım.

 

[Feylosof]

Bende hazırlamıştım. Farklı komut kullanımından dolayı paylaşmak istedim.

Option Explicit

Sub Ad_Soyad_Yazim_Duzeni()
    Dim Son As Long, X As Long, Veri As Variant
    Dim Ad As Variant, Soyad As String, Say As Long
   
    Son = Cells(Rows.Count, 1).End(3).Row
    If Son < 2 Then Son = 2
   
    Veri = Range("A1:A" & Son).Value
   
    ReDim Liste(1 To UBound(Veri, 1), 1 To 1)
   
    For X = LBound(Veri, 1) To UBound(Veri, 1)
        Say = Say + 1
        If Veri(X, 1) <> "" Then
            Ad = Split(WorksheetFunction.Proper(Veri(X, 1)), " ")
            If UBound(Ad, 1) = 0 Then
                Liste(Say, 1) = Ad(0)
            Else
                Soyad = Ad(UBound(Ad, 1))
                ReDim Preserve Ad(0 To UBound(Ad, 1) - 1)
                Liste(Say, 1) = Join(Ad, " ") & " " & UCase(Replace(Replace(Soyad, "ı", "I"), "i", "İ"))
            End If
        End If
    Next
   
    Range("A1").Resize(UBound(Veri, 1)) = Liste
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sayın @Korhan Ayhan üstadım size çok teşekkür ederim.

 

[Feylosof]

@Korhan Ayhan hocam bir şey daha sorabilir miyim. Liste farklı sütunlarda olabiliyor bazen. Bu durumda kodun hangi kısmında değişiklik yaparsam istediğim sütunda iş görür.

 

[Feylosof]

@Korhan Ayhan hocam bir şey daha sorabilir miyim. Liste farklı sütunlarda olabiliyor bazen. Bu durumda kodun hangi kısmında değişiklik yaparsam istediğim sütunda iş görür.

Çözdüm galiba. Tekrardan teşekkürler.