Otomatik Düzeltme

[EKREM1661]

Çok değerli arkadaşlar.! Excel sayfasına alt-alta adres kayıtları yapılıyor. Girilen veya yapıştırılan adres kayıtlarındaki düzensizliklerin, en aza indirilebilmesi için, aşağıdaki formata göre otomatik düzeltme yaptırılabilmesi..?

2.nci satırdan itibaren;

C ve D sütunlarındaki metinler "Yazım Düzeni" ilk harfler büyük,
E sütunu (örn. Osmangazi / BURSA) taksim sonrası büyük harf
F ile G sütunlarındaki metinler BÜYÜKHARF

biçiminde, otomatik düzeltme sağlasın..

 

[Korhan Ayhan]

Aşağıdaki kodu sayfanızın kod bölümüne uygulayıp deneyiniz.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Alan As Range, Veri As Range, X As Long, Say As Variant, Metin As String, Onay As Byte
    
    On Error GoTo Son
    
    Application.EnableEvents = False
    
    If Target.Cells.Count = 1 Then
        Set Alan = Target
    Else
        Set Alan = Selection.Cells
    End If
    
    For Each Veri In Alan
        If Veri.Column = 3 Then
            Say = WorksheetFunction.CountIf(Range("C:C"), Veri.Value)
            If Say > 1 Then GoTo 10
        End If
    Next
    
    GoTo 20

10  Onay = MsgBox("Mükerrer kayıt tespit edilmiştir. İşleme devam etmek istiyor musunuz?", vbCritical + vbYesNo + vbDefaultButton2)
    If Onay = vbNo Then
        GoTo Son
    Else
20      For Each Veri In Alan
            Select Case Veri.Column
                Case 3, 4
                    Veri.Value = WorksheetFunction.Proper(Veri.Value)
                Case 5
                    If InStr(1, Veri.Value, "/") > 0 Then
                        Say = Split(Veri.Value, "/")
                        For X = 0 To UBound(Say)
                            If X <> UBound(Say) Then
                                If Metin = "" Then
                                    Metin = WorksheetFunction.Proper(Say(X))
                                Else
                                    Metin = Metin & "/" & WorksheetFunction.Proper(Say(X))
                                End If
                            Else
                                Metin = Metin & "/" & UCase(Replace(Replace(Say(X), "ı", "I"), "i", "İ"))
                            End If
                        Next
                    End If
                    Veri.Value = IIf(Metin = "", WorksheetFunction.Proper(Veri.Value), Metin)
                    Metin = ""
                Case 6, 7
                    Veri.Value = UCase(Replace(Replace(Veri.Value, "ı", "I"), "i", "İ"))
            End Select
        Next
    End If
    
Son: Application.EnableEvents = True
End Sub

 

[EKREM1661]

Saygıdeğer hocam, çok harika olmuş, elinize sağlık, bilginiz daim olsun.. Yazdığınız bu kod kalıbına bir de mükerrer girişi önlemek için (C sütunu kriter alınarak) ilave yapmak istedim, fakat sağlıklı olmadı, hata falan vermeye başladı. Yani, girilen veya yapıştırılan bilgi, önce mükerrer ise uyarı verip, devam edilsin mi gibi seçenek sunmuş olsa diye düşündüm..

Fakat hocam, işinize gelirse diyorum.. Yoksa yaptığınız yardım, beni ziyadesiyle memnun etti..

 

[Korhan Ayhan]

Merhaba,

Üstteki mesajımda ki kodu revize ettim.

Tekrar deneyiniz.

 

[EKREM1661]

Korhan hocam.! Tekrar tekrar teşekkür ederim ve sağlıklı günler dilerim.