Satır Silme

[dkotil]

Merhaba,

Ekte ki dosyada H stununda ki veri "YEC" kelimesini içermesi durumunda veya L stununda ki hücre "m07tlo1" e eşit oldugu durumlarda o satırları silebilecek bir makro yazmaya çalışıyorum. Üstte ki butona atayarak butona bastıgımda o satırların silinmesi içimi görecek. Yardımcı olursanız çok sevinirim.

 

[apocalyt]

şunu deneyin..

Sub daylight()
Set a = Range("h:h").Find("*YEC*", , , 1)
If Not a Is Nothing Then
adr = a.Address
Do
Set a = Range("h:h").Find("*YEC*", , , 1)
Set a = Range("h:h").FindNext(a)
b = a.Address
a.EntireRow.Delete
d = d + 1
Loop While Not a Is Nothing And b <> adr
End If
Set a = Range("l:l").Find("*m07tlo1*", , , 1)
If Not a Is Nothing Then
adr = a.Address
Do
Set a = Range("l:l").Find("*m07tlo1*", , , 1)
Set a = Range("l:l").FindNext(a)
b = a.Address
a.EntireRow.Delete
e = e + 1
Loop While Not a Is Nothing And b <> adr
End If
MsgBox "H sütunundan dolayı " & d & "adet," & " L Sutunundan dolayı " & e & " adet satır silinmiştir."
End Sub

 

[dkotil]

Merhaba,

Teşekkür ederim fakat bir sıkıntım var. Hücrede sadece YEC yazmıyor YEC2012 şeklinde yada YEC2011 şeklinde yazıyor bu nedenle içinde YEC varsa yazmamız gerekiyor onu nasıl yapıyoruz bilmedim. Şu anki durumda çalışmadı ama hücreyi silip sadece YEC yazdıgımda çalıştı. Bu konuda da yardımcı olabilir misiniz ?

 

[apocalyt]

yukarıdaki kodda düzenleme yaptım..bir deneyiniz..

 

[dkotil]

Çok teşekkür ederim çalışıyor, elinize sağlık..

 

[apocalyt]

2 nolu mesajımda belirttiğiiz şekilde düzeltme yaptım..kolay gelsin..

 

[dkotil]

Çok teşekkurler..

 

[dkotil]

Merhaba,

Bu satırları ayrı bir sheet'e aldıktan sonra asıl sayfadan silmek istiyorum bunun için;
"a.EntireRow.Delete" satırından önce nasıl bir komut eklemeliyim ? Yani içinde "m07tlo1" geçenleri ayrı bir sheete alıp asıl sayfadan silecek.

Şimdiden teşekkür ederim..

 

[antonio]

Sayın apocalyt in beynine yüreğine sağlık. Kodlarını şu şekilde değiştirirseniz istediğinizi gerçekleştirmiş olursunuz:

Sub Sartli_Sil()
 
Set a = Range("h:h").Find("*YEC*", , , 1)
If Not a Is Nothing Then
adr = a.Address
Do
Set a = Range("h:h").Find("*YEC*", , , 1)
Set a = Range("h:h").FindNext(a)
b = a.Address
d = d + 1
a.EntireRow.Copy Sheet2.Range("A" & d)
a.EntireRow.Delete

Loop While Not a Is Nothing And b <> adr
End If
Set a = Range("l:l").Find("*m07tlo1*", , , 1)
If Not a Is Nothing Then
adr = a.Address
Do
Set a = Range("l:l").Find("*m07tlo1*", , , 1)
Set a = Range("l:l").FindNext(a)
b = a.Address
e = e + 1
a.EntireRow.Copy Sheet3.Range("A" & e)
a.EntireRow.Delete

Loop While Not a Is Nothing And b <> adr
End If
MsgBox "H sütunundan dolayı " & d & "adet," & " L Sutunundan dolayı " & e & " adet satır silinmiştir."
End Sub

aradığınız ve silinmesini istediğiniz verileri Sheet2 ve Sheet3 sayfalarına taşıdıktan sonra, ilgili satırları siler.

 

[apocalyt]

hocam sizinde elinize yüreğinize sağlık..

 

[dkotil]

Çalıştı.. elinize sağlık arkadaşlar, çok teşekkür ederim..