Bir kritere göre satır sildirme.

[TheSins]

Arkadaşlar D sutununda bulunan rakamları sildiğimde Sayfa ikideki uzantılarını da silmek istiyorum....Örnek dosya alttadır...Yardımınıza ihtiyacım var...Şimdidden teşekkür ederim ilgilenen arkadaşlar için...

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki kodu denermisiniz.

Option Explicit
 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Intersect(Target, [D:D]) Is Nothing Then Exit Sub
    If Target = "" Then
    Sheets("Sayfa2").Range("A" & Target.Row & ":C" & Target.Row) = ""
    End If
End Sub

 

[TheSins]

Private Sub Worksheet_Change(ByVal Target As Range) komutunda hata veriyor ama bunu bir macroya eklemeye calisiyorum ancak o makronun kodlarini da bunla basladim....
bir fikriniz var mi?

 

[Korhan Ayhan]

Selamlar,

Vermiş olduğum kodu sayfa ismi üzerinde sağ klik yapın ve KOD GÖRÜNTÜLE seçeneğini seçin. Açılan pencereye uygulayın. Sanırım siz kodu modüle eklediniz. Bu kod sayfaya ait bir koddur. Bu sebeple modüle eklerseniz hata mesajı alırsınız.

 

[TheSins]

Teşekkür ederim Korhan bey vermiş oldugunuz kodu o alana uyguluyorum zaten ancak orada da benim yazmış oldugum kodlar var bir macronun içine ekliyorum en altına...boşken çalışıyor kodlar ama benim kodların altına eklediğimde bu hatayı veriyor...hatta size programın tamamını göndereyim ekte Korhan bey...


Not:bu dosyada bu sildirme olayı sipariş ve plan sayfaları arasındadır Korhan bey...

 

[Korhan Ayhan]

Selamlar,

Sizin kullandığınız kod ile benim önerdiğim kodu birleştirmek gerekiyor. Aşağıdaki kodu denermisiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [F3:F65536]) Is Nothing Then Exit Sub
    If Target = "" Then
    With Sheets("PLAN")
    Set BUL = .Range("C:C").Find(Cells(Target.Row, "B"))
    If Not BUL Is Nothing Then
    .Range("C" & BUL.Row & ":G" & BUL.Row) = ""
    End If
    Set BUL = Nothing
    End With
    End If
    
   '#########################################################
   'KALIP1 İÇİN
    
    b = 1
    a = 3
    For z = 1 To 6
    For y = 4 To 7
    
    If Target = b And Target.Row > 2 And Target.Row < 27 Then
    Sheets("plan").Cells(y, a) = Target.Offset(0, -4)
    Sheets("plan").Cells(y, a + 1) = Target.Offset(0, -3)
    Sheets("plan").Cells(y, a + 3) = Target.Offset(0, -2)
    Sheets("plan").Cells(y, a + 4) = Target.Offset(0, -1)
    End If
    b = b + 1
    Next y
    a = a + 6
    Next z
   
    '#######################################################
    'KALIP2
    
    b = 1
    a = 3
    For z = 1 To 6
    For y = 8 To 23
    
    If Target = b And Target.Row > 26 And Target.Row < 123 Then
    Sheets("plan").Cells(y, a) = Target.Offset(0, -4)
    Sheets("plan").Cells(y, a + 1) = Target.Offset(0, -3)
    Sheets("plan").Cells(y, a + 3) = Target.Offset(0, -2)
    Sheets("plan").Cells(y, a + 4) = Target.Offset(0, -1)
    End If
    b = b + 1
    Next y
    a = a + 6
    Next z
    
    '#######################################################
    'KALIP3
    
    b = 1
    a = 3
    For z = 1 To 6
    For y = 25 To 28
    
    If Target = b And Target.Row > 122 And Target.Row < 147 Then
    Sheets("plan").Cells(y, a) = Target.Offset(0, -4)
    Sheets("plan").Cells(y, a + 1) = Target.Offset(0, -3)
    Sheets("plan").Cells(y, a + 3) = Target.Offset(0, -2)
    Sheets("plan").Cells(y, a + 4) = Target.Offset(0, -1)
    End If
    b = b + 1
    Next y
    a = a + 6
    Next z
    
    '#######################################################
    'KASE
    
    b = 1
    a = 3
    For z = 1 To 6
    For y = 29 To 31
    
    If Target = b And Target.Row > 146 And Target.Row < 164 Then
    Sheets("plan").Cells(y, a) = Target.Offset(0, -4)
    Sheets("plan").Cells(y, a + 1) = Target.Offset(0, -3)
    Sheets("plan").Cells(y, a + 3) = Target.Offset(0, -2)
    Sheets("plan").Cells(y, a + 4) = Target.Offset(0, -1)
    End If
    b = b + 1
    Next y
    a = a + 6
    Next z
    
End Sub

 

[TheSins]

Çok teşekkür ederim Korhan bey verdiğiniz kodlar işe yaradı tekrardan çok teşekkür ederim şimdi bunları diger satırlar içinde ben uygulayayım şuanki kodlar sadece c sutunundakileri siliyor gerisini halledebilirim sanırım

 

[TheSins]

Korhan bey çok teşekkür ederim programı hallettim sonunda Şu an istediğim gibi çalışıyor...Emekleriniz için teşekkürler tekrardan...