Değer Girince Diğer Sütundaki Değer Silinsin

[sirkülasyon]

Hayırlı Sabahlar.
Kandiliniz Mübarek Olsun.

Değerli Arkadaşlar

D4 : 16 sütun aralığında değer var.
F4:F16 sütun arasına değer girilince D4: 16 arasında ki değer silinsin istiyorum. Yardımcı olabilir misiniz?

Örnek:

F5 hücresine veri girişi yapılınca D5 hücresinde ki veri silinsin.
F15 hücresine veri girişi yapılınca D15 hücresinde ki veri silinsin.

Yardımınız için Teşekkür eder saygılarımı sunarım.

 

[çıtır]

Teşekkür ederim.Sizinde kandiliniz mübarek olsun.Sayfa kodu olarak kopyalayınız.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:F16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "F") <> "" Then
Cells(Target.Row, "D") = ""
End If
End Sub

 

[YUSUF44]

Sayfanın kod bölümüne yapıştırıp deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [D4:D16]) Is Nothing Then Exit Sub
Target.Offset(0, 2) = ""
End Sub

 

[sirkülasyon]

Sayın ÇITIR
Sayın YUSUF44
Teşekkür eder, saygılarımı sunarım. Var olun, sağ olun

 

[çıtır]

Sayın ÇITIR
Sayın YUSUF44
Teşekkür eder, saygılarımı sunarım. Var olun, sağ olun

Rica ederim.Dönüş yaptığınız için teşekkür ederim.

 

[sirkülasyon]

Özür dileyerek ve affınıza sığınarak makro konusunda bir ricada bulunabilir miyim?
İlk mesajımda
F5 hücresine veri girişi yapılınca D5 hücresinde ki veri silinsin.
F15 hücresine veri girişi yapılınca D15 hücresinde ki veri silinsin. diye belirtmiştim. Lakin idare tarafından bir değişiklik istendi.

F5 hücresine veri girişi D5 hücresinde ki veri ile aynı ise silinsin, Değil ise farkını yazsın.
Örnek
D5 hücresinde 15000 yazıyor. F5 hücresine 15000 girilirse D5 hücresi silinsin.
Eğer ki;
D5 hücresinde 15000 yazıyor. F5 hücresine 12500 girilirse D5 hücresine 2500 yazsın.

 

[YUSUF44]

Aşağıdaki gibi dener misiniz?

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:F16]) Is Nothing Then Exit Sub
If Target = Target.Offset(0, -2) Then
    Target.Offset(0, -2) = ""
Else
    Target.Offset(0, -2) = Target.Offset(0, -2) - Target
End If
End Sub

 

[sirkülasyon]

Yusuf Hocam
Çok çok teşekkür ederim.
Hakkını Helal et.

 

[çıtır]

Yusuf Hocam cevaplamış.Bende yazayım.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:F16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "D") = Cells(Target.Row, "F") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "F")
End If
End Sub

 

[sirkülasyon]

Sayın çıtır
Yardımlarınızı esirgemediğiniz için teşekkür ederim.

 

[çıtır]

Sayın çıtır
Yardımlarınızı esirgemediğiniz için teşekkür ederim.

Rica ederim.Dönüş yaptığınız için teşekkür ederim.Kolay gelsin.

 

[sirkülasyon]

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:F16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "D") = Cells(Target.Row, "F") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "F")
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [H4:H16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "D") = Cells(Target.Row, "H") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "H")
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [J4:J16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "D") = Cells(Target.Row, "J") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "J")
End If
End Sub

üç kodun birleşmesi için yardımcı olabilir misiniz?

 

[YUSUF44]

Aşağıdaki kodu deneyiniz:

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [F4:F16]) Is Nothing Then GoTo 10
If Cells(Target.Row, "D") = Cells(Target.Row, "F") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "F")
End If

10:
If Intersect(Target, [H4:H16]) Is Nothing Then GoTo 20
If Cells(Target.Row, "D") = Cells(Target.Row, "H") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "H")
End If

20:
If Intersect(Target, [J4:J16]) Is Nothing Then Exit Sub
If Cells(Target.Row, "D") = Cells(Target.Row, "J") Then
Cells(Target.Row, "D") = ""
Else
Cells(Target.Row, "D") = Cells(Target.Row, "D") - Cells(Target.Row, "J")
End If
End Sub

 

[sirkülasyon]

Yusuf Hocam
Çok çok Teşekkür Ederim. Sağ Olasın.