Noktalı harfleri noktasız hale getirme

[ASLAN7410]

Merhaba hayırlı bayramlar.

Ekte gönderdiğim excel dosyamın E sütununda Türkçe karakterli bazı kelimeler var, bu kelimelerin başında ve sonunda boşluklar var, aralarında da fazladan boşluklar var.

Ben butona bastığımda hangi sütunu dönüştürmek istiyorsam o sütunu Türkçe karakterli kelimeleri normale çevirmek, kelimenin başında, sonunda ve aralarındaki fazla boşlukları silmek istiyorum, hangi sütunda işlem yapıldıysa düzgün halini aynı sütuna yazmasını istiyorum.

İşlemi formülle yaptım işe yarıyor ancak işlem uzun sürüyor, formülün yaptığı bu işlemi Application.InputBox ile yapmak istiyorum.

Yardımcı olur musunuz?

 

[ASLAN7410]

Arkadaşlar forumda ve internette benim istediğim gibi bir şey bulamadım.

Yardımcı olur musunuz?

 

[Ömer BARAN]

Merhaba.
Aşağıdaki gibi deneyin.
Mavi kısım sütun adının yanlış yazılması halinde onu düzeltmek içindir.

Sub BARAN()
Application.Calculation = xlCalculationManual
sor = Application.InputBox("İşlem yapılacak sütun adını giriniz!..." & vbCrLf & " ", "Ö.BARAN", "A", Type:=2)
sor = UCase(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
    Replace(Replace(Replace(Replace(sor, "Ç", "C"), "ç", "c"), "ğ", "g"), _
    "Ğ", "G"), "İ", "I"), "ı", "i"), "Ö", "O"), "ö", "o"), "Ş", "S"), "ş", "s"), "Ü", "U"), "ü", "u"))
    If sor = False Then
        MsgBox "İşlemi iptal ettiniz.", vbInformation, "Ö.BARAN"
        GoTo 10
    ElseIf IsNumeric(sor) = True Then
        MsgBox "Sadece HARF yazınız.", vbInformation, "Ö.BARAN"
        GoTo 10
    ElseIf Len(sor) > 1 Then
        MsgBox "Sadece 1 adet HARF yazmalısınız.", vbInformation, "Ö.BARAN"
        GoTo 10
    ElseIf Cells(Rows.Count, sor).End(3).Row = 1 Then
        MsgBox "Belirtilen sütunda işlem yapılacak veri yok.", vbInformation, "Ö.BARAN"
        GoTo 10
    Else
        For sat = 2 To Cells(Rows.Count, sor).End(3).Row
            Cells(sat, sor) = WorksheetFunction.Trim(UCase(Replace(Replace(Replace(Replace(Replace(Replace(Replace(Replace( _
                    Replace(Replace(Replace(Replace(Cells(sat, sor), "Ç", "C"), "ç", "c"), "ğ", "g"), _
                    "Ğ", "G"), "İ", "I"), "ı", "i"), "Ö", "O"), "ö", "o"), "Ş", "S"), "ş", "s"), "Ü", "U"), "ü", "u")))
        Next
        MsgBox "İşlem tamam.", vbInformation, "Ö.BARAN"
    End If
10: Application.Calculation = xlCalculationAutomatic
End Sub

 

[ASLAN7410]

Sayın Ömer Bey, hayırlı geceler hayırlı bayramlar diliyorum.

Tam istediğim gibi çalışıyor, çok teşekkür ediyorum, valla süper oldu, ellerinize sağlık.

 

[Ömer BARAN]

Bilmukabele, ben de sizin Kurban Bayramınızı kutluyorum.

Estağfurullah, kod'da fazlalık kısımlar olabilir belki.
Her neyse önemli olan ihtiyacın karşılanması değil mi?

 

[ASLAN7410]

Sayın Ömer Bey, zahmet olmazsa koddaki fazlalık dediğiniz yerleri sadeleştirip gönderebilir misiniz?

 

[Haluk]

İşinize yararsa, biraz daha sade bir kod aşağıdadır ....

Değiştirilecek hücrelerin tümünü fare ile seçtikten sonra, aşağıdaki makroyu çalıştırabilirsiniz.

Sub Test()
    Dim Rng As Range
    For Each Rng In Selection
        Rng = StrConv(Rng.Text, vbUpperCase, 1033)
        Rng = StrConv(Rng.Text, vbUpperCase, 64)
    Next
End Sub

.

 

[Ömer BARAN]

Fazlalık değil ama eksiklik var diye düşündüm.
Inputbox'a 1'den fazla karakter yazılması, harf dışında karakter yazılması, yazılan sütunda veri olmaması gibi seçenkeleri de ekledim.
Sayfayı yenileyerek önceki kod cevabımı tekrar kontrol ediniz.

 

[Ömer BARAN]

Haluk usta yine konuşturmuş.

 

[Haluk]

Haluk usta yine konuşturmuş.

Estağfurullah Ömer Bey ... saygı ve sevgiler.

.

 

[ASLAN7410]

Sayın Ömer Bey, çok teşekkür ediyorum, ellerinize sağlık, çok güzel çalışıyor.

Hayırlı geceler, hayırlı bayramlar diliyorum.

 

[ASLAN7410]

Sayın Haluk Bey, sizinde ilginize çok teşekkür ediyorum, kod gayet güzel çalışıyor.
Ama fazla boşlukları kırpmıyor, bu da olursa sizin kodda çok güzel olacak.

 

[Haluk]

Aslan Bey;

Bir satır daha ilave edersek, o da olur ...

Sub Test()
    Dim Rng As Range
    For Each Rng In Selection
        Rng = StrConv(Rng.Text, vbUpperCase, 1033)
        Rng = StrConv(Rng.Text, vbUpperCase, 64)
        Rng = WorksheetFunction.Trim(Rng)
    Next
End Sub

 

[ASLAN7410]

Sayın Haluk Bey, kelime başındaki ve sonundaki boşlukları siliyor.
Kelime arasındaki fazla boşlukları kırpmıyor.

 

[Haluk]

13 No'lu mesajdaki kod revize edildi.

.

 

[ASLAN7410]

Sayın Haluk Bey, ellerinize sağlık çok teşekkür ediyorum.

Hayırlı geceler, hayırlı bayramlar diliyorum.

 

[ASLAN7410]

Sayın Ömer Bey, en son gönderdiğiniz koddaki mesaj kutusuna yanlışlıkla noktalı harflerden ç,ü,ö,i,ş harflerden birisini yazdığımda kod hata veriyor.

Önceki gönderdiğiniz kodda bunu düzeltiyordu. Bu kısmı önceki kod gibi ayarlayabilir misiniz?

 

[Haluk]

Bilmukabele,

Size de iyi geceler, iyi bayramlar.

.

 

[Ömer BARAN]

Haluk Bey verdiğiniz kod'daki 1033 ve 64'ün anlamlarını belirtebilir misiniz?
Başka seçenekler de var mıdır?
Tahminim o ki; font ailesi anlamına geliyor ama, anlamak istediğim örneğin Ç'yi C olarak değiştirmesi nasıl oluyor acaba?
Birinin kod karşılığı 199 iken diğerinin 67 mesela.

 

[Ömer BARAN]

Yanlış kopyalamış olabilirim, sayfayı yenileyerek tekrar kontrol edin.