Adı küçük soyadı büyük harfle yazdırmak

[vitaminb1]

birde ayriyetten Ali DEMİR'in Ayşe ELMA'nın vb soyadından sonra gelen(') işaretinden sonra gelen yere soyadına uygun olarak in,nın,un ve şekilde küçük harflerle ek yazdırabilirmiyiz.

 

[Necdet]

Merhaba,

A sütununda Ad-Soyad'ların olduğunu varsayarak kod geliştirdim. Doğru mu anladım bilemiyorum, dosyayı inceleyiniz.

Public Sub Düzelt()
For i = 2 To [A65536].End(3).Row
    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 & """)")
    
    SonKarakter = Right(Soyad, 1)
    Select Case SonKarakter
        Case "A", "I": Ek = "'nın"
        Case "O", "U": Ek = "'nun"
        Case "E", "İ": Ek = "'nin"
        Case "Ö", "Ü": Ek = "'nün"
        Case Else
            SonKarakter = Left(Right(Soyad, 2), 1)
            Select Case SonKarakter
                Case "A": Ek = "'in"
                Case "I": Ek = "'ın"
                Case "O", "U": Ek = "'un"
                Case "E", "İ": Ek = "'in"
                Case "Ö", "Ü": Ek = "'ün"
                Case Else
                    SonKarakter = Left(Right(Soyad, 3), 1)
                    Select Case SonKarakter
                        Case "A": Ek = "'ın"
                        Case "I": Ek = "'ın"
                        Case "O", "U": Ek = "'un"
                        Case "E", "İ": Ek = "'in"
                        Case "Ö", "Ü": Ek = "'ün"
                    End Select
            End Select
    End Select
    Cells(i, "A") = Ad & " " & Soyad & Ek
Next i
End Sub

 

[vitaminb1]

evet aslında istedğim gibi fakat orada isimin değişmesi ve eklerin eklenmesi için bir butono basmak gerekiyor butuna basmadan(hiç birine basmadan otmatik değitirse) yazdıra yada enter tuşuna basınaca değisse tam istediğim gibi olacak. birde benimistediği A sutununu tümünde değilde A veya başka sutunun bir hücresinde benim yaptığım hücre D9 mesala.ben bu hücrede rapor almaya gelen kişilerin ismini yazıyorum.başka biri gelirse o hücreye onun ismini yazıyorum. Eğer istiyorsanız dosya eklerim.şimdi belge bu bilgisayarda değil.
SN.NECDET YEŞERTENER:Yapmış olduğunuz ve yapacağınız yardımlarınız için teşekkürler.

 

[vitaminb1]

süpersiniz be üsdat. bizim hayal ettiklerimizi siz yapıyorsunuz.valla süper

 

[Necdet]

Merhaba,

Sizin dediğiniz gibi butonsuz giriş sırasında otomatik olsun diye işyerinde yoğun iş arasında bakmıştım ama döngüye girdi sürekli ek yapıp durduğu için bu hale getirdim.

Şimdilik böyle idare edin kodlarda Cells(i, "A") gördüğünüz yeri [D9] yapın, 2. satırdaki For ile başlayan ve Sondan 2. satırdaki Next i satırını silin sadece D9 hücresi için çalışır.

 

[idare]

ben kod işlerini yeni yeni öğreniyorum. sayfaya buton ekleyemedim.ben belgeyi ekliyorum.bir önceki sayfada sn.tahsinanarat ın yaptığı kodda yazıldığı anda dönüşüyor. fakat onda benim istediğim gibi tek hücreye değil ve de ' işaretinden sonraki ekler yok.Tekrar incelesenzi. sn necdet yeşertener sizin yazdığınız kodla onun yazdığı kodun birleşiminden benim istediğim gibi bir kod yapılabilir belki.

 

[Necdet]

Merhaba,

Veri giriş sırasında adın YAZIM.DÜZENİ, soyadın BÜYÜKHARF'e çevrilirken sonuna ek in,ın,nın vs gibi ek alma kodları aşağıdadır. Range yada hücre belirlediğinizde Sütun(lar) ve Hücre de çalışacaktır. Değişmesi gereken yer kırmızı ile yazılmıştır.

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [[B][COLOR=red]H12[/COLOR][/B]]) Is Nothing Then Exit Sub
    Sonuç = ""
    Ad = ""
    Soyad = ""
    a = Split(Target, " ")
    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 & """)")
    
    SonKarakter = Right(Soyad, 1)
    Select Case SonKarakter
        Case "A", "I": Ek = "'nın"
        Case "O", "U": Ek = "'nun"
        Case "E", "İ": Ek = "'nin"
        Case "Ö", "Ü": Ek = "'nün"
        Case Else
            SonKarakter = Left(Right(Soyad, 2), 1)
            Select Case SonKarakter
                Case "A": Ek = "'ın"
                Case "I": Ek = "'ın"
                Case "O", "U": Ek = "'un"
                Case "E", "İ": Ek = "'in"
                Case "Ö", "Ü": Ek = "'ün"
                Case Else
                    SonKarakter = Left(Right(Soyad, 3), 1)
                    Select Case SonKarakter
                        Case "A": Ek = "'ın"
                        Case "I": Ek = "'ın"
                        Case "O", "U": Ek = "'un"
                        Case "E", "İ": Ek = "'in"
                        Case "Ö", "Ü": Ek = "'ün"
                    End Select
            End Select
    End Select
    Application.EnableEvents = False
    Sonuç = Ad & " " & Soyad & Ek
    With Target
        .Value = Sonuç
        Application.EnableEvents = True
     End With
     
    Range("D:D").EntireColumn.AutoFit
    Range("H:H").EntireColumn.AutoFit
Son:
End Sub

 

[vitaminb1]

teşekkürler yardımlarınız ve değerli zamanınızı ayırdınız için.

 

[gulevurgun]

Bu benimde çok işime yaradı Allah razı olsun.

 

[siberati]

yazdığınız anda dönüştürülmesini istiyorsanız;

Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:Z"))
If Not IntersectRng Is Nothing Then
Target = WorksheetFunction.Proper(Trim(Target))
z = StrReverse(Target)
x = InStr(1, z, " ")
If x > 0 Then
y = Mid(z, 1, InStr(1, z, " "))
For i = 1 To Len
c = c & WorksheetFunction.Proper(Mid(y, i, 1))
Next
Target = Mid(Target, 1, Len(Target) - x) & StrReverse(c)
End If
End
End If
Set IntersectRng = Nothing
End Sub

Yukarıdaki makro çalışıyor hem de tam istediğim gibi, ancak belirtilen hücreye yazdığınız ad soyadı delet ile sildiğiniz zaman hata veriyor. end debug geliyor. Sonra da ad soyadı küçük büyük şeklinde yazmıyor yani makro devre dışı oluyor. Buna da bir çözüm üretirseniz memnun olurum. Bir de büyük harfle yazılan I harfini İ olarak yazıyor. Her ne kadar bu konu yıllar önce açılmış olsa da bakarsanız sevinirim. Şimdiden teşekkür ediyorum.

 

[siberati]

Tahsin Bey çok teşekkür ederim.

 

[siberati]

Örnek dosyayı da ekleyim dedim.

Yeni gönderdiğiniz makro süper. Ellerine sağlık. Okulda böyle programlar çok iş görüyor. Ama bizim için zor böyle şeyleri yapmak. Tekrar teşekkürler.

 

[tahsinanarat]

Sn. Siberati sizden sonucu öğrenmeden buraya yazmayacaktım, işinizi görmesine sevindim, verdiğim kodları yine önceden bu siteden temin etmiştim. Adı küçük Soyadı BÜYÜK yapan ve türkçe karakter sorunu yaşatmayan kodlar şöyle;

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, Range("G1:G65000")) Is Nothing Then Exit Sub
Application.EnableEvents = False
Target = WorksheetFunction.Proper(Target)
If InStr(1, Target, " ") > 0 Then
Veri_1 = Split(Target, " ")
Veri_2 = Replace(Target, Veri_1(UBound(Veri_1)), "")
Target = Veri_2 & UCase(Replace(Replace(Veri_1(UBound(Veri_1)), "ı", "I"), "i", "İ"))
End If
Son: Application.EnableEvents = True
End Sub

 

[_Berke_]

arkadaşlar merhaba ben yeniyim de bu kodları nasıl exel kaydediyoruz

 

[ZorBey_]

Merhaba
İyi Çalışmalar

Excel Sayfası Açıkken
Kodlar Hangi Sayfada Çalışacaksa
O Sayfayı Açın
Örnek
Sayfa1 Adını Sağ Tıklayın
Kod Görüntüle
Veya
Alt+F11
Kod Bölümü Açılacaktır
Kodları Oraya Kopyalayın