• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Şartlı satır silme

Katılım
29 Mayıs 2008
Mesajlar
16
Excel Vers. ve Dili
2003 TÜRKÇE
Herkese merhaba.

Ekteki dosyada "O" sütununda 0.2 ya da daha büyük bir sayı gördüğümüzde,
o satırdan başlayarak "J" sütununda -120'ye gelene kadar ki bütün satırları silmek istiyorum. Nasıl bir kod yazmalıyım.
Silinmesini istediğim kısımları sarıya boyadım.

Yardımlarınız için şimdiden teşekkür ederim.

Not: Dosyanın orjinali yaklaşık 200000 satır.
 

Ekli dosyalar

Merhaba

Bu kod işinizi görür mü?
Kod:
Sub sil()
For i = 2 To Range("O65536").End(3).Row
If Cells(i, "O").Value >= 0.2 Then
bas = i
Exit For
End If
Next
For j = i To Range("O65536").End(3).Row
If Abs(Cells(j, "j").Value) = 120 Then
son = j
Exit For
End If
Next
Range("J" & bas & ":" & "J" & son).ClearContents
End Sub
 
İlgilendiğiniz için teşekkürler. Kod istediğime yakın çalışıyor ama tam değil. Kod istenilen kritere uygun hücreleri buluyor ve J hücresi içindeki değerleri siliyor benim istediğim istenilen kriterdeki satırın tamamını silmek. Tekrar yardımcı olursanız sevinirim. Teşekkürler şimdiden.
 
İlgilendiğiniz için teşekkürler. Kod istediğime yakın çalışıyor ama tam değil. Kod istenilen kritere uygun hücreleri buluyor ve J hücresi içindeki değerleri siliyor benim istediğim istenilen kriterdeki satırın tamamını silmek. Tekrar yardımcı olursanız sevinirim. Teşekkürler şimdiden.

Bu mudur?
Kod:
Sub sil()
For i = 2 To Range("O65536").End(3).Row
If Cells(i, "O").Value >= 0.2 Then
bas = i
Exit For
End If
Next
For j = i To Range("O65536").End(3).Row
If Abs(Cells(j, "j").Value) = 120 Then
son = j
Exit For
End If
Next
Range("A" & bas & ":" & "O" & son).ClearContents
End Sub
 
Teşekkür ederim tam istediğim gibi olmuş. Verdiğiniz kodda "Clearcontent" yerine "delete" yazdığımda istediğim işlemi tam olarak gerçekleştiriyor. Çok olmuyorsam son birşey daha isteyeyim. Bu kodla sayfadaki istenilen kriterleri tek tek buluyor ve siliyor. Kodu bir kere çalıştırdığımızda sayfanın tamamında bu işlemi yapabilir mi? Yani bi kere çalıştırsak kritere uyan bütün satırları silmesi mümkün mü? Yardımlarınız için şimdiden teşekkürler.
 
Teşekkür ederim tam istediğim gibi olmuş. Verdiğiniz kodda "Clearcontent" yerine "delete" yazdığımda istediğim işlemi tam olarak gerçekleştiriyor. Çok olmuyorsam son birşey daha isteyeyim. Bu kodla sayfadaki istenilen kriterleri tek tek buluyor ve siliyor. Kodu bir kere çalıştırdığımızda sayfanın tamamında bu işlemi yapabilir mi? Yani bi kere çalıştırsak kritere uyan bütün satırları silmesi mümkün mü? Yardımlarınız için şimdiden teşekkürler.

Merhaba
Ortalama 40 satır silinecek düşüncesiyle k sabiti bulunup, bu kadar döngü kurulmasıyla sayfanın tamamında kriterlere uyan satırları silebilirsiniz.
Kod:
Sub sil()
For k = 1 To Int(Range("O65536").End(3).Row / 40)
Rem Ortalama 40 satır silinecek varsayımı ile döngü kuruluyor
For i = 2 To Range("O65536").End(3).Row
If Cells(i, "O").Value >= 0.2 Then
bas = i
Exit For
End If
Next
Rem bas, bir değer içeriyorsa devam etmesi sağlanıyor
If Not bas = Empty Then
For j = i To Range("O65536").End(3).Row
If Abs(Cells(j, "j").Value) = 120 Then
son = j
Exit For
End If
Next
'Range("A" & bas & ":" & "O" & son).ClearContents
Range("A" & bas & ":" & "O" & son).Delete
End If
Next k
End Sub

Esasında her defasında sayfanın en başından başlatmak doğru bir yaklaşım değil, basit olması açısından bu yol seçilmiştir.
Doğrusu, kaldığı yerden devam etmesidir.

Not:
Satırları silmeden içeriğini silmek doğru yaklaşım olur.
Bunun için kodu çalıştırmadan .ClearContents şeklinde deneyin.
Doğru sonucu alıyorsanız .Delete şeklinde kullanırsınız.
 
Merhaba

Alternatif bu kodu da deneyiniz.
Kod:
Sub sil_2()
For k = 2 To Range("O65536").End(3).Row
For i = k To Range("O65536").End(3).Row
If Cells(i, "O").Value >= 0.2 Then
bas = i
Exit For
End If
Next i
If Not bas = Empty Then
For j = i To Range("O65536").End(3).Row
If Abs(Cells(j, "j").Value) = 120 Then
son = j
Exit For
End If
Next j
Range("A" & bas & ":" & "O" & son).ClearContents
End If
k = son
Next k
        Columns("A:A").Select
        Selection.SpecialCells(xlCellTypeBlanks).Select
        Selection.EntireRow.Delete
        Range("a1").Select
End Sub
 
Çok teşekkür ederim. Elinize sağlık. İkinci verdiğiniz kod tam istediğim gibi çalıştı. Tekrar teşekkürler. Kolay gelsin.
 
Geri
Üst