Ad ve Soyadlar...

[Nadir]

Merhaba,

Kişilerin ad ve soyadlarını hücreye küçük harfle yazıp enter ladıktan sonra şu şekilde olmasını sağlayabilirmiyiz... (İlgili sayfanın Worksheet_Change olayında)

Ã?rnek: Ali AKTAÞ, veya kişi çift isimli olabilir. Ã?rnek2: Mehmet Ali AKTAÞ

 

[Haluk]

Merhaba;

Bir deneyin bakalım işinize yarayacak mı ?

[vb:1:09d4dc77ee]Private Sub Worksheet_Change(ByVal Target As Range)
Target = Trim(Target)
x = InStr(1, Target, " ")
If x > 0 Then
Target = WorksheetFunction.Proper(Target)
y = Mid(Target, x + 1, 98)
Target = WorksheetFunction.Substitute(Target, y, UCase)
End If
End
End Sub
[/vb:1:09d4dc77ee]

 

[Haluk]

Bu işin sadece A sütununda olmasını isterseniz;

[vb:1:cc127420b5]Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:A"))
If Not IntersectRng Is Nothing Then
Target = Trim(Target)
x = InStr(1, Target, " ")
If x > 0 Then
Target = WorksheetFunction.Proper(Target)
y = Mid(Target, x + 1, 98)
Target = WorksheetFunction.Substitute(Target, y, UCase)
End If
End
End If
Set IntersectRng = Nothing
End Sub
[/vb:1:cc127420b5]

 

[Necdet]

Sayın Raider,

denedim çok güzel olmuş elinize sağlık, yalnız küçük "I" harfinde sorun var, onu büyük yazmıyor

 

[Haluk]

denedim çok güzel olmuş elinize sağlık, yalnız küçük "I" harfinde sorun var, onu büyük yazmıyor

Merhaba;

Bir de bu şekliyle deneyin isterseniz ...

[vb:1:6e72f7f742]Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:A"))
If Not IntersectRng Is Nothing Then
Target = Trim(Target)
x = InStr(1, Target, " ")
If x > 0 Then
Target = WorksheetFunction.Proper(Target)
y = Mid(Target, x + 1, 98)
For i = 1 To Len
c = c & WorksheetFunction.Proper(Mid(y, i, 1))
Next
Target = WorksheetFunction.Substitute(Target, y, c)
End If
End
End If
Set IntersectRng = Nothing
End Sub
[/vb:1:6e72f7f742]

 

[Nadir]

Sayın Raider, çok teşekkür ederim.

Ama iki isimlilerde, kişinin ikinci ismini de büyük harfe çeviriyor.
Ã?rnek: Mehmet Ali AKTAÞ olması gerekirken, Mehmet ALİ AKTAÞ şekline çeviriyor.

 

[Haluk]

Ama iki isimlilerde, kişinin ikinci ismini de büyük harfe çeviriyor.

Hmmm... o detayı atlamışım, pardon.

Bir bakayım ona şimdi....

 

[Haluk]

Merhaba Nadir bey;

Araya işler girince hemen ilgilenemedim özür dilerim.

Biraz hızlıca oldu ama, bir de aşağıdaki şekliyle denermisiniz ?

[vb:1:4df80d2dc2]Private Sub Worksheet_Change(ByVal Target As Range)
Set IntersectRng = Application.Intersect(Target, Range("A:A"))
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
[/vb:1:4df80d2dc2]

 

[Nadir]

Sayın Raider,

Ã?zür dilemenize gerek yok, incelik göstermişsiniz. Ben de ancak şimdi cevap yazabiliyorum. Evet, araya işler giriyo...Yardımlarınız için teşekkürler.

Kodunuzu denedim, istenilen şekilde çalışıyor. Fakat enter ladıktan sonra çalışması uzun sürüyor. 3-4 snaniyelik bi gecikme...Yazınca da, silince de...Lütfen bunu koda güzellik katılabilmesi bakımından anlayın. Buldu da, gibilerinden değil de... .

 

[hazan_25]

Merhaba,

Sayın Raider bu son yazdığınız visual basic kodunu TextBox için düzenleyebilirmisiniz?

 

[Levent Menteşoğlu]

Textbox için aşağıdaki kodu denermisiniz.

[vb:1:41dbb2420b]Private Sub TextBox1_Change()
If TextBox1.Value = "" Then Exit Sub
For a = 1 To Len(TextBox1.Value)
harf = Mid(TextBox1.Value, a, 1)
If a = 1 Then harf = WorksheetFunction.Proper(harf)
If c = 1 Then
harf = WorksheetFunction.Proper(harf)
c = c + 1
End If
If c > 2 Then harf = WorksheetFunction.Proper(harf)
kelime = kelime & harf
If harf = " " Then c = c + 1
Next
c = 0
TextBox1 = kelime
End Sub
[/vb:1:41dbb2420b]

Not:Kodda bazı eksikler olduğunu farkettim. Tam sonuç bir sonraki cevabımda verilmiştir.

 

[hazan_25]

Sayın Moderatörüm leventm,

Harikasınız! Teşekkürler... :bravo:

 

[Haluk]

Buldu da, gibilerinden değil de... .

ehehhe.....alemsiniz Nadir bey......


Başka bir konuda herhangibir forumda olsanız... garanti banlanmıştınız şimdi :mrgreen:

 

[Levent Menteşoğlu]

Yukarıda ilk verdiğim kodun sadece 3 isimli kayıtlarda doğru çalışacak şekilde olduğunu gördüm, bu durumu atlamışım. Bu sebeple aşağıdaki kod tam olarak istenileni verecektir. Kod textboxtan çıkıldığı anda çalışacaktır.

[vb:1:d3afb40756]Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo 10
If TextBox1.Value = "" Then Exit Sub
a = WorksheetFunction.Search(" ", TextBox1.Value, 1)
bir = WorksheetFunction.Proper(Mid(TextBox1.Value, 1, a - 1))
son = WorksheetFunction.Search(" ", TextBox1.Value, a + 1)
iki = WorksheetFunction.Proper(Mid(TextBox1.Value, a + 1, son - a - 1))
For say = son + 1 To Len(TextBox1.Value)
d = WorksheetFunction.Proper(Mid(TextBox1.Value, say, 1))
uc = uc & d
Next
TextBox1 = bir & " " & iki & " " & uc
Exit Sub
10 For say = a + 1 To Len(TextBox1.Value)
b = WorksheetFunction.Proper(Mid(TextBox1.Value, say, 1))
iki = iki & b
Next
TextBox1 = bir & " " & iki
End Sub
[/vb:1:d3afb40756]