hücredeki değişikliğe göre

[uguristanbul]

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Son
If Intersect(Target, [C7:E65536]) Is Nothing Then Exit Sub
If Target.Row < 7 Then Exit Sub

If UCase(Cells(Target.Row, "C")) = "S" Then
Cells(Target.Row, "F") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
Cells(Target.Row, "G") = 0
ElseIf UCase(Cells(Target.Row, "C")) = "A" Then
Cells(Target.Row, "G") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
Cells(Target.Row, "F") = 0
End If
Son:
End Sub
bu kodda c sütununa s yazarsam d ve e yi carpıp f ye yazıyor a yazarsamda dyi ve e yi carpıp g ye yazıyor ancak c deki değişiklikleri algılamıyor
yani örnek:c7 ye s yazdım d7 ve e7 carptı sonucu f ye yazdı ama c7 deki s yi siler veya değiştirisem carpım sonucu gene f de kalıyor bunu silmesi gerekli
nasıl yapabilirim
saygılar

 

[Necdet]

Merhaba,

Aşağıdaki şekilde dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [B][COLOR=red][E:E][/COLOR][/B]) Is Nothing Then Exit Sub
    If Target.Row < 7 Then Exit Sub
    
    [COLOR=red][B]Application.EnableEvents = False
[/B][/COLOR]    If UCase(Cells(Target.Row, "C")) = "S" Then
        Cells(Target.Row, "F") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
        Cells(Target.Row, "G") = 0
    ElseIf UCase(Cells(Target.Row, "C")) = "A" Then
        Cells(Target.Row, "G") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
        Cells(Target.Row, "F") = 0
    Else
[B][COLOR=red]        MsgBox "Cinsi Yanlış Girdiniz...", vbCritical, "Cins Girişi Hatası" 
        Target = ""
        Target.Offset(0, -2).Select
[/COLOR][/B]    End If
    [COLOR=red][B]Application.EnableEvents = True
[/B][/COLOR]Son:
End Sub

 

[uguristanbul]

yapmadı hocam eskisi gibi gene

 

[Korhan Ayhan]

Selamlar,

Aynı içerikli sorularınızı aynı başlık altında sorabilirsiniz. Yeni başlık açmanıza gerek yok.

Aşağıdaki şekilde deneyin.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo Son
    If Intersect(Target, [C7:E65536]) Is Nothing Then Exit Sub
    If Target.Row < 7 Then Exit Sub
    
    Application.EnableEvents = False
        If UCase(Cells(Target.Row, "C")) = "S" Then
            Cells(Target.Row, "F") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
            Cells(Target.Row, "G") = 0
        ElseIf UCase(Cells(Target.Row, "C")) = "A" Then
            Cells(Target.Row, "G") = Cells(Target.Row, "D") * Cells(Target.Row, "E")
            Cells(Target.Row, "F") = 0
        ElseIf Cells(Target.Row, "C") = "" Then
            Range(Cells(Target.Row, "D"), Cells(Target.Row, "J")) = ""
        Else
            Cells(Target.Row, "F") = ""
            Cells(Target.Row, "G") = ""
        End If
Son:
    Application.EnableEvents = True
End Sub

 

[uguristanbul]

hocam ellerinize sağlık mükemmel olmuş
saygılar