türkçe karakter yasağı

[burj_11]

Herkese Merhabalar,

bir hücrede türkçe karakter kullanılmasını engellemek için ne yapmalıyım?

Yardımcı olursanız çok sevinirim

 

[N.Ziya Hiçdurmaz]

yanıt

A1 Hücresinde çalışır

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deg As String
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
deg = LCase(Replace(Replace(Replace(Replace(Replace( _
[a1], "ö", "o"), "ü", "u"), "ş", "s"), "ç", "c"), "ğ", "g"))
[a1] = deg
End Sub

 

[halit3]

ziya beyin formülüne ek olarak
birde aşağıdaki kodu denermisiniz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim tara As String
a = Target.Row
b = Target.Column
yaz = Sheets(ActiveSheet.Name).Cells(a, b).Value
deg = (Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
[yaz], "ö", "o"), "Ö", "O"), "ı", "i"), "İ", "I"), "ü", "u"), "Ü", "U"), "ş", "s"), "Ş", "S"), "Ç", "C"), "ç", "c"), "Ğ", "G"), "ğ", "g"))
[yaz] = tara

End Sub

 

[burj_11]

Teşekkurler,

ellerinize sağlık

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki koduda kullanabilirsiniz. Ekteki örnek dosyada istediğiniz hücreye türkçe karakter yazmayı deneyiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Eski_Karakter As Variant, Yeni_Karakter As Variant, X As Byte
    On Error GoTo Son
    Eski_Karakter = Array("ç", "Ç", "ğ", "Ğ", "i", "İ", "ö", "Ö", "ş", "Ş", "ü", "Ü")
    Yeni_Karakter = Array("c", "C", "g", "G", "ı", "I", "o", "O", "s", "S", "u", "U")
    For X = 0 To UBound(Eski_Karakter)
        Application.EnableEvents = False
        Target = Replace(Target, Eski_Karakter(X), Yeni_Karakter(X))
        Application.EnableEvents = True
    Next
Son: Application.EnableEvents = True
End Sub

 

[Necdet]

Merhaba,

2007 sürüm de denediğimde dağıtım dagitim olmadı.

 

[Korhan Ayhan]

Selamlar,

Necdet bey,

Bende deneme amaçlı 2007 sürümünü sistemime kurmuştum. Bir çalışma esnasında BÜYÜKHARF fonksiyonunu kullanmam gerekti. Fakat "iletişim" tarzında bir kelimeyi büyük harfe dönüştürürken "ILETIŞIM" şeklinde sonuç almıştım. Bu problemide sadece " i " harfinde yaşamıştım. Daha sonrada alışkanlıktan dolayı tekrar 2003 sürümüne dönmeyi tercih ettim.

 

[Necdet]

Merhaba,

Korhan Bey bende bu sorunu aşamadım 2007 de, çaktırmadan acaba çözüm bulmuş arkadaşlar var mı diye sordum.

 

[Merhum İdris SERDAR]

Merhaba,

Korhan Bey bende bu sorunu aşamadım 2007 de, çaktırmadan acaba çözüm bulmuş arkadaşlar var mı diye sordum.

Sayın Necdet Yeşertener ,

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Eski_Karakter As Variant, Yeni_Karakter As Variant, X As Byte
On Error GoTo Son
Eski_Karakter = Array("ç", "Ç", "ğ", "Ğ", "i", "ı", "İ", "ö", "Ö", "ş", "Ş", "ü", "Ü")
Yeni_Karakter = Array("c", "C", "g", "G", "i", "i", "I", "o", "O", "s", "S", "u", "U")
For X = 0 To UBound(Eski_Karakter)
Application.EnableEvents = False
Target = Replace(Target, Eski_Karakter(X), Yeni_Karakter(X))
Application.EnableEvents = True
Next
Son: Application.EnableEvents = True
End Sub

Kırmızı yerleri ekleyin.

.

 

[Necdet]

Sayın Yurttaş,

Kodlar doğru çalıştı. Teşekkür ederim.

 

[Refractory]

teşekkürler bilgiler için.

 

[sarman61]

Ekleme

Direk metinleri kopyala yapıştır yaptığımızda türkçe karakterleri düzeltmiyor ancak satıra f2 ile girip çıktığımızda düzeltiyor bunu nasıl çözebiliriz?

Şimdiden teşekkürler...

 

[CyberBlade_]

A1 Hücresinde çalışır

Private Sub Worksheet_Change(ByVal Target As Range)
Dim deg As String
If Intersect(Target, [a1]) Is Nothing Then Exit Sub
deg = LCase(Replace(Replace(Replace(Replace(Replace( _
[a1], "ö", "o"), "ü", "u"), "ş", "s"), "ç", "c"), "ğ", "g"))
[a1] = deg
End Sub

Sadece A1 hücresi için çalıştırdığımda ekteki satırda hata veriyor bunu nasıl çözebiliriz?

If Intersect(Target, [a1]) Is Nothing Then Exit