son kelime hariç ilk Harfin Yanlız Büyük olması

[canercan02]

öncelikle bütün forum üyelerinin yeni yılı kutlu olsun.
sorunum şu;
a stününda yüzlerce isim var. genelde ad ve soyad büyük harflerle yazılmış. benim yapmak istediğim ad kısmının İlk harfi büyük, soyadı (son kelime) bölümünün tümünün büyük yazılması

yani makro ile

CANER CAN yerine Caner CAN yazılması
CANER ALİ CAN yerine Caner Ali CAN yazılması.

 

[Necdet]

Merhaba,

A sütununda Ad ve Soyadların olduğu ve birinci satırın başlık satırı olduğu varsayılmıştır.

Sub Ad_Soyad_Bicimlendir()
    Dim i       As Long
    Dim j       As Integer
    Dim a
    Dim Ad      As String
    Dim Soyad   As String
 
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
 
        Ad = ""
        Soyad = ""
        a = Split(Trim(Cells(i, "A")), " ")
 
        If UBound(a) = 0 Then
            Ad = Trim(Cells(i, "A"))
        Else
            For j = 0 To UBound(a) - 1
                Ad = Trim(Ad & " " & a(j))
            Next j
            Soyad = Trim(a(UBound(a)))
        End If
 
        Ad = Evaluate("=PROPER(""" & Ad & """)")
        Soyad = Evaluate("=UPPER(""" & Soyad & """)")
 
        Cells(i, "A") = Ad & " " & Soyad
 
    Next i
 
End Sub

 

[sbayyigit]

ben de bu kodları siteden buldum

Sub soyad_ayir()
For i = 1 To [A65536].End(3).Row
Ad = ""
Soyad = ""
a = Split(Cells(i, "A"), " ") '-- Hücre değerini boşluklara göre dizine çıkartıyor
For j = 0 To UBound(a) - 1 ' dizi elemanından 1 eksiği Ad olacağı varsayıma göre döngüye sokularak Ad belirleniyor
Ad = Trim(Ad & " " & a(j)) 'Dizinin Son elemanı hariç diğerleri birleştiriliyor (ki bu Ad oluyor)
Next j

Soyad = Trim(a(UBound(a))) 'Dizinin Son elemanını verir (ki bu da Soyaddır)
Ad = Evaluate("=PROPER(""" & Ad & """)") 'Adına yazım.düzeni (Proper) uygulanıyor
Soyad = Evaluate("=UPPER(""" & Soyad & """)") 'Soyadına BÜYÜKHARF (Upper) uygulanıyor
Cells(i, "A") = Ad & " " & Soyad 'Aynı hücrede ad ve soyad birleştiriliyor
Next i
End Sub

 

[Necdet]

ben de bu kodları siteden buldum

Açıklamaları güzel tutmuşsunuz, tebrik ederim.
Ben yanlış anımsamıyorsum açıklama eklememiştim.

 

[leumruk]

Merhaba,
Soru cevaplanmış; ama alternatif bir çözüm ürettim.

Sub dene()
For x = 1 To [a65536].End(3).Row
If Cells(x, "a") <> "" Then
hcr = Trim(Evaluate("=PROPER(""" & Cells(x, "a") & """)"))
deg = Split(hcr, " ")
Cells(x, "a") = Left(hcr, Len(hcr) - Len(deg(UBound(deg)))) & Evaluate("=UPPER(""" & deg(UBound(deg)) & """)")
End If
Next
End Sub

 

[sbayyigit]

Açıklamaları güzel tutmuşsunuz, tebrik ederim.
Ben yanlış anımsamıyorsum açıklama eklememiştim.

Saygıdeğer hocam; dediğim gibi siteden buldum. kodlar sizindi ama açıklamayı kim eklemişti tam olarak hatırlamıyorum bana da gerekmişti, alıp kullanmıştım. allah emeği geçen herkesten razı olsun

 

[canercan02]

Merhaba,

A sütununda Ad ve Soyadların olduğu ve birinci satırın başlık satırı olduğu varsayılmıştır.

ben de bu kodları siteden buldum

Merhaba,
Soru cevaplanmış; ama alternatif bir çözüm ürettim.

hepinize ayrı ayrı teşekkür ederim. hepsi de aynı işi gördü. hepinizin yeni yılı tekrar kutlu olsun.

 

[halit3]

Alternatif olarakta bende kullanıcı tanımlı fonksiyonla yazılmış kod ekliyorum.

Function ADBUL(sayi)
say = 0
sayi = WorksheetFunction.Trim(sayi)
For j = Len(sayi) To 1 Step -1
If Mid(sayi, j, 1) = " " Then
say = Mid(sayi, 1, j - 1)
Exit For
End If
Next j
ADBUL = WorksheetFunction.Proper(say)
If say = 0 Then
ADBUL = ""
End If
Exit Function
End Function

Function SOYADBUL(sayi)
say = 0
sayi = WorksheetFunction.Trim(sayi)
For j = Len(sayi) To 1 Step -1
If Mid(sayi, j, 1) = " " Then
say = j + 1
Exit For
End If
Next j
If say > 0 Then
deg1 = Mid(sayi, say, Len(sayi))
deg2 = Replace(deg1, "i", "İ")
deg3 = Replace(deg2, "ı", "I")
SOYADBUL = UCase(deg3)
Else
SOYADBUL = ""
End If
Exit Function
End Function