Bir hücredeki veri silinirken diğer bilgilerin silinmesi

[sedat2161]

İyi günler iyi çalışmalar arkadaşlar. Ekli dosyamda T ve U sütununda bulunan veryi sildiğimde yanında bulunan L:R aralığındaki bilgilerde silebilir miyiz acaba. Yardımcı olursanız çok memnun olurum.

 

[Muzaffer Ali]

Merhaba.

Sayfa adını sağ tıklatın "Kod Görüntüle" seçin açılan sayfaya aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T:U")) Is Nothing Then Exit Sub
    If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
        Range("L" & Target.Row & ":R" & Target.Row).ClearContents
    End If
End Sub

T ve U her ikisi birden boş olduğunda L, R arasındaki hücrelerin içiniz siler

 

[sedat2161]

Merhaba.

Sayfa adını sağ tıklatın "Kod Görüntüle" seçin açılan sayfaya aşağıdaki kodları kopyalayın.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, Range("T:U")) Is Nothing Then Exit Sub
    If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
        Range("L" & Target.Row & ":R" & Target.Row).ClearContents
    End If
End Sub

T ve U her ikisi birden boş olduğunda L, R arasındaki hücrelerin içiniz siler

Sayın Dalgalikur çok teşekkür ederim.

 

[sedat2161]

Sayın Dalgalikur çok teşekkür ederim.

İyi günler iyi çalışmalar arkadaşlar. Sayın dalgalikur dün sorunumuma cevap buldu. Yanlız aynı sayfada başka bir kod olduğundan sorun çıktı. Dosyam ektedir. yardımcı olursanız çok sevinirim.

 

[Muzaffer Ali]

Merhaba.

Bütün kodları silip aşağıdakileri kopyalayın.
Deneme şansım olmadı deneyip geri dönüş yaparsınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B1:F1")) Is Nothing Then
        On Error Resume Next
      
        If Target.Count > 3 Then
            ActiveSheet.ShowAllData
        End If
        If Range("B1") = Empty And Range("c1") = Empty And Range("D1") = Empty And Range("E1") = Empty And Range("F1") = Empty Then
            ActiveSheet.ShowAllData
        Else
            If Target = Range("B1") Then
                Range("b2:F3").AutoFilter Field:=1, Criteria1:="*" & Target.Text & "*", VisibleDropDown:=True
            End If
        End If
    End If
  
    If Not Intersect(Target, Range("T:U")) Is Nothing Then
        If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
            Range("L" & Target.Row & ":R" & Target.Row).ClearContents
        End If
    End If
End Sub

 

[sedat2161]

Merhaba.

Bütün kodları silip aşağıdakileri kopyalayın.
Deneme şansım olmadı deneyip geri dönüş yaparsınız.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("B1:F1")) Is Nothing Then
        On Error Resume Next
     
        If Target.Count > 3 Then
            ActiveSheet.ShowAllData
        End If
        If Range("B1") = Empty And Range("c1") = Empty And Range("D1") = Empty And Range("E1") = Empty And Range("F1") = Empty Then
            ActiveSheet.ShowAllData
        Else
            If Target = Range("B1") Then
                Range("b2:F3").AutoFilter Field:=1, Criteria1:="*" & Target.Text & "*", VisibleDropDown:=True
            End If
        End If
    End If
 
    If Not Intersect(Target, Range("T:U")) Is Nothing Then
        If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
            Range("L" & Target.Row & ":R" & Target.Row).ClearContents
        End If
    End If
End Sub

İyi günler iyi çalışmalar arkadaşlar. Dalgalikur arkadaşımız kodları yeniden yazdı Allah razı olsun denmemişti. denedim sil kodu çalışıyor. Üstte filtreleme kodu çalışmıyor. Yardımlarınızı bekliyorum. iyi çalışmalar.

 

[Muzaffer Ali]

Merhaba.
Kodları yeniden düzenledim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Long
    If Not Intersect(Target, Range("B1:F1")) Is Nothing Then
        On Error Resume Next
        If Target.Count > 3 Then
            ActiveSheet.ShowAllData
        End If
        If Range("B1") = Empty And Range("c1") = Empty And Range("D1") = Empty And Range("E1") = Empty And Range("F1") = Empty Then
            ActiveSheet.ShowAllData
        Else
            SonSatir = Cells(Rows.Count, "F").End(3).Row
            Range("B2:F" & SonSatir).AutoFilter Field:=Target.Column - 1, Criteria1:="*" & Target.Text & "*"
        End If
    End If
    If Not Intersect(Target, Range("T:U")) Is Nothing Then
        If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
            Range("L" & Target.Row & ":R" & Target.Row).ClearContents
        End If
    End If
End Sub

Ancak örnek dosyada filtreleme çalışmaz.
Çünkü veriler sayısal olduğu için "*" & Target.Text & "*" şeklinde "içerir" kriteri belirtemezsiniz.
Eğer orjinal dosyanızda da sadece rakamlar varsa Target.Text şeklinde yazınız.

 

[sedat2161]

Merhaba.
Kodları yeniden düzenledim.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim SonSatir As Long
    If Not Intersect(Target, Range("B1:F1")) Is Nothing Then
        On Error Resume Next
        If Target.Count > 3 Then
            ActiveSheet.ShowAllData
        End If
        If Range("B1") = Empty And Range("c1") = Empty And Range("D1") = Empty And Range("E1") = Empty And Range("F1") = Empty Then
            ActiveSheet.ShowAllData
        Else
            SonSatir = Cells(Rows.Count, "F").End(3).Row
            Range("B2:F" & SonSatir).AutoFilter Field:=Target.Column - 1, Criteria1:="*" & Target.Text & "*"
        End If
    End If
    If Not Intersect(Target, Range("T:U")) Is Nothing Then
        If Cells(Target.Row, "T") = "" And Cells(Target.Row, "U") = "" Then
            Range("L" & Target.Row & ":R" & Target.Row).ClearContents
        End If
    End If
End Sub

Ancak örnek dosyada filtreleme çalışmaz.
Çünkü veriler sayısal olduğu için "*" & Target.Text & "*" şeklinde "içerir" kriteri belirtemezsiniz.
Eğer orjinal dosyanızda da sadece rakamlar varsa Target.Text şeklinde yazınız.

Hayırlı Cumalar iyi çalışmalar. Kod çok iyi çalıştı. Çok teşekkür ederim. İyi çalışmalar