• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Private Sub Worksheet_Change Kodunun Çalışmaması

  • Konbuyu başlatan Konbuyu başlatan u.L.a.s
  • Başlangıç tarihi Başlangıç tarihi
Katılım
8 Eylül 2008
Mesajlar
950
Excel Vers. ve Dili
2016 İngilizce
Sheet1 de aşağıdaki kod düzeneğim var
ilk kod B sütunundaki girilen verilerin ilk harflerini büyük yapmayı sağlıyor
ikinci kod ise C sütununda bulunan mahalle sokak gibi kelimeler içeren adres verisinde mah. sok. gibi kısaltmalar yapıyor.

Şimdi ben Eğer ilk kodumu başa alırsam B sütununda kod çalışıyor ama C sütununda girilen bir veride değişiklik olmuyor
Eğer ben ilk kodu aşağı alırsam yani ikinci örnek gibi yaparsam bu sefer B sütununda çalışacak kod işlemiyor. C sütunundaki kod çalışıyor.

Bunun önüne nasıl geçebilirim acaba bilgi ve yardımlarınızı rica ederim

İLIK ÖRNEK
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)

'B sütununda bulunan verilerin ilk harflerini büyük yapar
If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
If Not Target.Value = "" Then
Application.EnableEvents = False
Target.Value = Application.WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If

'C Sütununa girilen adres verisinde bazı verileri kısaltır
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Application.EnableEvents = False
bul = Array("mahalle", "cadde", "sokak", "bulvar")
deg = Array("mah.", "cad.", "sok.", "blv.")
metin = Split(Target.Value, " ")
For b = LBound(metin) To UBound(metin)
    For c = LBound(bul) To UBound(bul)
        If InStr(1, metin(b), bul(c), vbTextCompare) = 1 Then
            metin(b) = deg(c)
            Exit For
        End If
    Next
Next
Target.Value = Join(metin, " ")
Application.EnableEvents = True
End If
End Sub

İKİNCİ ÖRNEK
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
'C Sütununa girilen adres verisinde bazı verileri kısaltır
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("C:C")) Is Nothing Then
Application.EnableEvents = False
bul = Array("mahalle", "cadde", "sokak", "bulvar")
deg = Array("mah.", "cad.", "sok.", "blv.")
metin = Split(Target.Value, " ")
For b = LBound(metin) To UBound(metin)
    For c = LBound(bul) To UBound(bul)
        If InStr(1, metin(b), bul(c), vbTextCompare) = 1 Then
            metin(b) = deg(c)
            Exit For
        End If
    Next
Next
Target.Value = Join(metin, " ")
Application.EnableEvents = True
End If

'B sütununda bulunan verilerin ilk harflerini büyük yapar
If Intersect(Target, [B2:B65536]) Is Nothing Then Exit Sub
If Not Target.Value = "" Then
Application.EnableEvents = False
Target.Value = Application.WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End Sub
 
1. kodda kırmızı renk olarak belirttiğim şekilde yazdığım zaman kodu düzeldi sorun.

Kod:
    Private Sub Worksheet_Change(ByVal Target As Range)

    'B sütununda bulunan verilerin ilk harflerini büyük yapar
   [B][COLOR="Red"] If Not Intersect(Target, [B2:B65536]) Is Nothing Then[/COLOR][/B]
    If Not Target.Value = "" Then
    Application.EnableEvents = False
    Target.Value = Application.WorksheetFunction.Proper(Target.Value)
    Application.EnableEvents = True
    End If
    End If

    'C Sütununa girilen adres verisinde bazı verileri kısaltır
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("C:C")) Is Nothing Then
    Application.EnableEvents = False
    bul = Array("mahalle", "cadde", "sokak", "bulvar")
    deg = Array("mah.", "cad.", "sok.", "blv.")
    metin = Split(Target.Value, " ")
    For b = LBound(metin) To UBound(metin)
        For c = LBound(bul) To UBound(bul)
            If InStr(1, metin(b), bul(c), vbTextCompare) = 1 Then
                metin(b) = deg(c)
                Exit For
            End If
        Next
    Next
    Target.Value = Join(metin, " ")
    Application.EnableEvents = True
    End If
    End Sub
 
Geri
Üst