Kodlar çalışmıyor

[ASLAN7410]

Merhaba hayırlı akşamlar.

Aşağıdaki kodlar bu şekilde çalışıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Then
If Target.Row >= 7 And Target.Row <= 56 Then
On Error Resume Next
If Target.Value <> "" Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End If
End If

On Error Resume Next
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
If Target <> UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then _
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
End Sub

Kodu aşağıdaki gibi yaptığımda hiç biri çalışmıyor.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("D7:G56")) Is Nothing Then
On Error Resume Next
If Target.Value <> "" Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If

On Error Resume Next
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
If Target <> UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then _
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))

If Intersect(Target, Range("O6,R6")) Is Nothing Then Exit Sub
    Sheets("ASLAN").Range("H58").FormulaR1C1 = "=R[-52]C[22]"
    Sheets("ASLAN").Range("H59").FormulaR1C1 = "=R[-52]C[22]"
    Sheets("ASLAN").Range("H60").FormulaR1C1 = "=R[-52]C[22]"
End Sub

If Target.Column = 4 Or Target.Column = 5 Or Target.Column = 6 Or Target.Column = 7 Then
If Target.Row >= 7 And Target.Row <= 56 Then

Yani kod içerisindeki yukarıdaki kısmi aşağıdaki kod ile değiştirdim, kod çalışmadı.

If Intersect(Target, Range("D7:G56")) Is Nothing Then

Kod'un alt kısmına aşağıdaki kodu ekledim bu sefer hiç biri çalışmadı.

If Intersect(Target, Range("O6,R6")) Is Nothing Then Exit Sub
Sheets("ASLAN").Range("H58").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H59").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H60").FormulaR1C1 = "=R[-52]C[22]"

Yardımcı olur musunuz?

 

[FERAZ]

Olmalı.

If Not Intersect(Target, Range("D7:G56")) Is Nothing Then

 

[ASLAN7410]

Sayın Zafer Bey, hayırlı akşamlar.

Sizin dediğiniz gibi aşağıdaki şekilde yaptım çalıştı.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("D7:G56")) Is Nothing Then
On Error Resume Next
If Target.Value <> "" Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End If

On Error Resume Next
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
If Target <> UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then _
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))
End Sub

Yukarıdaki kodların en alt kısmına aşağıdaki kodu ekliyorum bu kod çalışmıyor. Ne yapmam gerekiyor.

If Intersect(Target, Range("O6,R6")) Is Nothing Then Exit Sub
Sheets("ASLAN").Range("H58").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H59").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H60").FormulaR1C1 = "=R[-52]C[22]"

 

[ASLAN7410]

3 ayrı kodu Private Sub Worksheet_Change(ByVal Target As Range) bu başlık altında çalıştırmak istiyorum.

 

[FERAZ]

If Intersect(Target, Range("O6,R6")) Is Nothing Then Exit Sub

Hayırlı akşamlar.
Bu kod ile ne yapmak istiyorsunuz?

 

[FERAZ]

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

Yerine

If Not Intersect(Target, [A3]) Is Nothing Then
Kodlar
End if

Gibi yazarsanız kodlar bence daha iyi olur.Telefondan bukadar yazabiliyorum.

 

[ASLAN7410]

1.Kod D7 ile G56 arasındaki girilen bilgilerin baş harflerini düzeltiyor.

If Not Intersect(Target, Range("D7:G56")) Is Nothing Then
On Error Resume Next
If Target.Value <> "" Then
Application.EnableEvents = False
Target.Value = WorksheetFunction.Proper(Target.Value)
Application.EnableEvents = True
End If
End If

2.Kod A3 hücresine girilen bilgileri büyük harf yapıyor.

On Error Resume Next
If Intersect(Target, [A3]) Is Nothing Then Exit Sub
If Target <> UCase(Replace(Replace(Target, "i", "İ"), "ı", "I")) Then _
Target = UCase(Replace(Replace(Target, "i", "İ"), "ı", "I"))

3.Kod benim eklemeye çalıştığım kod'da O6 veya R6 hücresi değiştiğinde aşağıdaki H58,H59,H60 hücrelerine formül yazmasını istiyordum.

If Intersect(Target, Range("O6,R6")) Is Nothing Then Exit Sub
Sheets("ASLAN").Range("H58").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H59").FormulaR1C1 = "=R[-52]C[22]"
Sheets("ASLAN").Range("H60").FormulaR1C1 = "=R[-52]C[22]"

 

[FERAZ]

Yani exit sub kısmı kodun çalışmasını durduruyor olabilir bence.

 

[FERAZ]

Kodların anlamını biliyorumda exit subu niye yazdınız onu sormuştum aslında.Koşul sağlanmazsa kodu durdurur.Önceki dediğimi uygulayabilirsinşz.

 

[FERAZ]

If Not Intersect(Target, Range("O6,R6")) Is Nothing Then 
Sheets("ASLAN").Range("H58").FormulaR1C1 = "=R[-52]C[22]"
End if

Mantıken böyle olmalı diğer iki tane formüülü kodu ekleyip end ifin alt satırına en son yapmak istediğiniz kodu ekleyin bence.

 

[ASLAN7410]

Sayın Zafer Bey, sizin dediğiniz gibi yaptım, çok teşekkür ediyorum, 3 kodun 3'de çalışıyor.
Hayırlı akşamlar diliyorum.

If Not Intersect(Target, Range("D7:G56")) Is Nothing Then
If Not Intersect(Target, [A3]) Is Nothing Then
If Not Intersect(Target, Range("O6,R6")) Is Nothing Then

 

[FERAZ]

Rica ederim,sizede hayırlı akşamlar.