Makro ile bir hücrede değer yoksa o satırı silen makro

[a_self_lion]

ARkadaşlar merhabalar benim bir sorunum var yardımcı olursanız sevinirım Benim 1250 satırlık bir taplom var bunu her hafta tekrarlıyorum meslaa bir ürün var bu ürünün 1. satırı a1 d1 e1 hüçresine kadar yerleri var ben istiyorum ki e 1 hüçresinde hiç değer yani birşey girili değilse o satırı silsin tabi bu alt alta e1250 ye kadar devam ediyor inşallah anlatabilmişimdir derdimi bütün e1 den başlayarak kontorol edecek e1250 ye kadar değeri boş olanların o satırı komle silecek

satırı derken a1 den e1 kadar olan komple satırı yani 1 satırı desem daha anlaşılır olacak.......

yardımlarınızı bekliyorum şimdiden teşkkür ederim ... :dua:

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:e05b77f1d7]Sub sil()
Application.ScreenUpdating = False
for a=[a65536].end(xlup).row to 1 step-1
if cells(a,5)=0 then rows(cells(a,5).row).delete
next
end sub
[/vb:1:e05b77f1d7]

 

[a_self_lion]

LEVENTM arkadaşım denedim olmadı yada ben sana anlatamadım şimdi
açıklamalı olarak sana o dosyadan bir kısa bir örnek gönderiyorum inceleyip bakarsan daha rahat anlaşılacak ve çözüme daha rahat ulaşacağımız kanısındayım yardımcı olursanız sevinirim....


dosyamı ekte gönderiyorum... Saygılarımla :dua:

 

[a_self_lion]

Lütfen yardım edin :yardim:

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin. Ancak boş olan hücreler gerçekten bış olmalıdır. Sizin dosyanızdaki boş görünen hücrelerde space tuşu ile boşluk verilmiş bu durumda kod işlem yapmaz. Bu boş hücreleri tekrar silerek deneyin.

[vb:1:6678607244]Sub sil()
Application.ScreenUpdating = False
For a = [f65536].End(xlUp).Row To 3 Step -3
If Cells(a, 5) = 0 And Cells(a, 6) = 0 Then Rows(Cells(a, 5).Row - 1 & ":" & Cells(a, 5).Row + 1).Delete
Next
End Sub
[/vb:1:6678607244]

 

[a_self_lion]

Teşekkürler arkadaş dediğin gibi bende fark ettim boşluk varmış space tuşu ile onları slince düzeldi makro tam benim istediğim gibi işledi
birde sizden şöyle bişey istesem çünkü ben çok büyük taploda bunları
tek tek seçip içeri temizlersem kendimde silebilirim fakat burda şöyle bir şey diye bilirmiyiz o baktığı hüçrelerde boşluk bildiğim kadarıyla harf karekter olarak algılar sayısal bir değer yoksa yani 0 dan büyük bir değer varsa diye yazarsak sanırım olur sizce nasıl olur

size zahmet olacak ama birde böyle yapabilirmiyiz

şimdiden teşekkür ederi... :hihoho: :arkadas:

 

[a_self_lion]

şimdi denedim de bir eksiklik var formülde çünkü malzeme kodlarının isimleirni silmiyor kontrol ettiği hüçreden sonra 3 satırı siliyor
ben tekrar gönderiyorum size dosyayı....

Tekrar bir bakarsan vede oraya şöyle bir sorgu eklersek yani yukarki mesajda da bahsettiğim gibi 0 dan büyük ise kalsın 0 küçük ise silsin veye boşluk varsa silsin gibi bunu dayaparsak sayın arkadaşım çok güzel olacak ve işime o kadar yarayacak ki size minnettar kalacağım şimdiden tekrar tekrar teşekkür ederim.......

 

[veyselemre]

[vb:1:90791dd7c3]Sub sil()
son = [b65536].End(3).Row
For x = son To 2 Step -3
If Cells(x - 1, 5) = 0 And Cells(x - 1, 6) = 0 Then Rows(x - 2 & ":" & x).Delete Shift:=xlUp
Next
End Sub
[/vb:1:90791dd7c3]

 

[Levent Menteşoğlu]

Sorun 40.satırdada boşluk olmamasından kaynaklanıyor, 40. satırı delete ile silerseniz doğru çalışır. Eğer space ile verilen boşluk sayıları heryerde eşitse kod içindeki "Cells(a, 5) = 0 And Cells(a, 6) = 0" yerine Cells(a, 5) =" " And Cells(a, 6) = " " şeklinde deneyin. Tırnak arasına hücredeki boşluk kadar verin.

 

[a_self_lion]

leventm yaa tam dediğiniz gibi yaptım ama yine çalışmıyor

Ne olur yardım edin şimdi size terar gönderiyorum o dosyayı bütün halini
bir incelerseniz sevinirim.... :arkadas: :dua:

 

[Levent Menteşoğlu]

Aşağıdaki kodu deneyin.

[vb:1:7337f0eec6]Sub sil()
Application.ScreenUpdating = False
For a = [d65536].End(xlUp).Row + 1 To 3 Step -3
If (Cells(a, 5) = 0 Or IsNumeric(Cells(a, 5)) = False) And (Cells(a, 6) = 0 Or IsNumeric(Cells(a, 6)) = False) Then Rows(Cells(a, 5).Row - 1 & ":" & Cells(a, 5).Row + 1).Delete
Next
End Sub[/vb:1:7337f0eec6]

 

[veyselemre]

[vb:1:29cb035000]Sub sil()
For x = [b65536].End(3).Row To 5 Step -3
If Cells(x - 1, 5) = String(16, " ") And Cells(x - 1, 6) = String(15, " ") Then Rows(x - 2 & ":" & x).Delete Shift:=xlUp
Next
End Sub
[/vb:1:29cb035000]