Worksheet_Change Olayında Sütundaki Rakamı İlk Haline Döndürme

[uyecik]

Arkadaşlar eklediğim excel dosyasında sanırım tam anlattım ama burada da şöyle bir açıklama yapmaya çalışayım.

Hücrenin yanındaki iki sütuna veri girdiğimde çarpıp eski halinin üzerine toplasın istiyorum. Sanırım bunu yaptım bir problem gözükmüyor ama silinince eski rakama getiremiyorum. Kafam iyice karıştı. Yardımlarınızı bekliyorum

 

[Muzaffer Ali]

Merhaba.

Sayfanın kodlarını silin aşağıdakileri kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, n, l, m As String
    If Target.Column = 1 Then
        If Cells(Target.Row, "C") = "" Then
            Cells(Target.Row, "C") = VBA.Date
        End If
        If IsNumeric(Cells(Target.Row - 1, Target.Column + 3)) And Cells(Target.Row - 1, Target.Column + 3) <> "" Then
            Cells(Target.Row, Target.Column + 3) = Cells(Target.Row - 1, Target.Column + 3) + 1
        End If
        Exit Sub
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        i = Cells(Target.Row, 14)
        MsgBox i
        If Target = "" Then
            Cells(Target.Row, "N") = Cells(Target.Row, "N") - Onceki_Deger
        Else
            If Cells(Target.Row, 14) = "" Then Cells(Target.Row, 14) = 0
            Cells(Target.Row, 14) = Cells(Target.Row, 14) + (Cells(Target.Row, 12) * Cells(Target.Row, 13))
        End If
        Exit Sub
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("L:M")) Is Nothing Then
        Onceki_Deger = Cells(Target.Row, Target.Column)
    End If
End Sub

 

[uyecik]

Merhaba.

Sayfanın kodlarını silin aşağıdakileri kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, n, l, m As String
    If Target.Column = 1 Then
        If Cells(Target.Row, "C") = "" Then
            Cells(Target.Row, "C") = VBA.Date
        End If
        If IsNumeric(Cells(Target.Row - 1, Target.Column + 3)) And Cells(Target.Row - 1, Target.Column + 3) <> "" Then
            Cells(Target.Row, Target.Column + 3) = Cells(Target.Row - 1, Target.Column + 3) + 1
        End If
        Exit Sub
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        i = Cells(Target.Row, 14)
        MsgBox i
        If Target = "" Then
            Cells(Target.Row, "N") = Cells(Target.Row, "N") - Onceki_Deger
        Else
            If Cells(Target.Row, 14) = "" Then Cells(Target.Row, 14) = 0
            Cells(Target.Row, 14) = Cells(Target.Row, 14) + (Cells(Target.Row, 12) * Cells(Target.Row, 13))
        End If
        Exit Sub
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("L:M")) Is Nothing Then
        Onceki_Deger = Cells(Target.Row, Target.Column)
    End If
End Sub

Hocam çok teşekkür ederim. Uğraşmışsınız, emek vermişsiniz ama bir şey değişmedi. Hala aynı şekilde devam ediyor. Acaba anlatamadım mı diye düşündüğüm için tekrar yazmaya çalışayım.

Örneğin N10 hücresinde 50 rakamı var. Ben L10 hücresine 5 değerini M10 hücresine de 3 değerini girince N10 hücresinin yeni değeri 65 olması lazım ki zaten oluyor. Ama ben L10 ve M10 hücrelerini temizlersem N10 hücresi tekrar 50 değerini görsün istiyorum.

 

[Muzaffer Ali]

O zaman aşağıdaki kodları deneyin.

Dim Onceki_Deger

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, n, l, m As String
    If Target.Column = 1 Then
        If Cells(Target.Row, "C") = "" Then
            Cells(Target.Row, "C") = VBA.Date
        End If
        If IsNumeric(Cells(Target.Row - 1, Target.Column + 3)) And Cells(Target.Row - 1, Target.Column + 3) <> "" Then
            Cells(Target.Row, Target.Column + 3) = Cells(Target.Row - 1, Target.Column + 3) + 1
        End If
        Exit Sub
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        i = Cells(Target.Row, 14)
        MsgBox i
        If Target = "" Then
            If Target.Column = 12 Then
                Cells(Target.Row, "N") = Cells(Target.Row, "N") - (Onceki_Deger * Cells(Target.Row, 13))
            ElseIf Target.Column = 13 Then
                Cells(Target.Row, "N") = Cells(Target.Row, "N") - (Onceki_Deger * Cells(Target.Row, 12))
            End If
        Else
            If Cells(Target.Row, 14) = "" Then Cells(Target.Row, 14) = 0
            Cells(Target.Row, 14) = Cells(Target.Row, 14) + (Cells(Target.Row, 12) * Cells(Target.Row, 13))
        End If
        Exit Sub
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("L:M")) Is Nothing Then
        Onceki_Deger = Cells(Target.Row, Target.Column)
    End If
End Sub

 

[uyecik]

O zaman aşağıdaki kodları deneyin.

Dim Onceki_Deger

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i, n, l, m As String
    If Target.Column = 1 Then
        If Cells(Target.Row, "C") = "" Then
            Cells(Target.Row, "C") = VBA.Date
        End If
        If IsNumeric(Cells(Target.Row - 1, Target.Column + 3)) And Cells(Target.Row - 1, Target.Column + 3) <> "" Then
            Cells(Target.Row, Target.Column + 3) = Cells(Target.Row - 1, Target.Column + 3) + 1
        End If
        Exit Sub
    ElseIf Target.Column = 12 Or Target.Column = 13 Then
        i = Cells(Target.Row, 14)
        MsgBox i
        If Target = "" Then
            If Target.Column = 12 Then
                Cells(Target.Row, "N") = Cells(Target.Row, "N") - (Onceki_Deger * Cells(Target.Row, 13))
            ElseIf Target.Column = 13 Then
                Cells(Target.Row, "N") = Cells(Target.Row, "N") - (Onceki_Deger * Cells(Target.Row, 12))
            End If
        Else
            If Cells(Target.Row, 14) = "" Then Cells(Target.Row, 14) = 0
            Cells(Target.Row, 14) = Cells(Target.Row, 14) + (Cells(Target.Row, 12) * Cells(Target.Row, 13))
        End If
        Exit Sub
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("L:M")) Is Nothing Then
        Onceki_Deger = Cells(Target.Row, Target.Column)
    End If
End Sub

Hocam size zahmet verdim emeğiniz için teşekkür ederim ama maalesef sonuca yine ulaşamadım. Ama ben bir şekilde biraz daha da geliştirerek hallettim. Belki başkasının da işine yarar diye dosyayı ekliyorum.

 

[Muzaffer Ali]

Sizin eklediğiniz dosyadaki işlemin aynısını yapıyor.
Kodları yanlış yere kopyaladınız sanırım.