• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan uyecik
  • Başlangıç tarihi Başlangıç tarihi
U

uyecik

Katılım
23 Temmuz 2008
Mesajlar
79
Excel Vers. ve Dili
türkçe 2003
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
 

Ekli dosyalar

Merhaba.

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

Kod: 
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
 
Muzaffer Ali' Alıntı:
Merhaba.

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

Kod: 
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
Genişletmek için tıkla ...

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.
 
O zaman aşağıdaki kodları deneyin.

Kod: 
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
 
Muzaffer Ali' Alıntı:
O zaman aşağıdaki kodları deneyin.

Kod: 
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
Genişletmek için tıkla ...
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.
 

Ekli dosyalar

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

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst