değeri "0" olan satırları silmek

[onuroz1456]

Merhaba,
birden çok sayfadan oluşan dosyamda, değeri 0 olan satırları silmek istiyorum.
Bunu yapacak bir makro konusunda yardım rica ediyorum.

 

[askm]

Örnek dosya ekleyebilir misiniz?

 

[Seyit Tiken]

Bu şekilde kendinize uyarlayabilirsiniz.

[a1:a100].Replace "0", ""

 

[askm]

Sayın Seyit Tiken belirttiği şekilde sıfır olan değerleri siliyor. 100 değerini 1 şekline çevirir. Yani istediğinizi karşılamayabilir.
Siz eğer sıfır olan satırları silmek istiyorsanız döngü kullanmak gerekir.
Öncelikle bütün sayfalar için bir döngü. Sonra hangi sütundaki değer sıfır ise o sütunu baz alarak son satıra kadar bir döngü kurmanız gerekir.

 

[onuroz1456]

Benim istediğim "0" olan değerlere ait satırları kaldırmak. küçükten büyüğe sıralayıp, elle siliyorum ama uzun sürüyor. aradığım komut kısaca "C" sütünü "0" ise satırı sil. Bunu makro yazıp tüm sayfaları bir kerede temizlemek amacım.

 

[askm]

Sub askm()
Dim son As Long
For Each c In Sheets
    c.Select
    son = c.Range("C" & Rows.Count).End(3).Row
    For i = son To 2 Step -1
        If c.Cells(i, 3) = 0 Then
            Rows(i).Delete
        End If
    Next i
Next
MsgBox "Silme işlemi tamamlandı...", vbInformation, "ASKM"
End Sub

 

[Seyit Tiken]

Bu şekilde deneyebilirsiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
For a = Cells(65536, 3).End(xlUp).Row To 1 Step -1
If Cells(a, "C") = 0 Then Rows(Cells(a, "C").Row).Delete
Next
End Sub

 

[onuroz1456]

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

 

[askm]

Rica ederim. Kolay gelsin.

 

[FERAZ]

Altarnatif olsun.

Sub sfr()

Dim rng As Range, bul As String, a As String, i As Integer

Application.ScreenUpdating = False

For i = 1 To Sheets.Count
With Sheets(i)
      Set rng = .Range("C:C").Find(What:=0, LookIn:=xlValues, lookat:=xlWhole)

If Not rng Is Nothing Then
       bul = rng.Address
    Do
      Set rng = .Range("C:C").FindNext(rng)
       a = a & rng.Address & ","
    Loop While Not rng Is Nothing And bul <> rng.Address
 .Range(Left(a, Len(a) - 1)).EntireRow.Delete

End If

End With
Next

Application.ScreenUpdating = True
Set rng = Nothing

End Sub

 

[onuroz1456]

Merhaba

Makroyu tüm sütunları içerecek şekilde revize edebilir miyiz?

 

[askm]

Sorunuzu örnek dosya ile destekleyiniz. Yapmak istediğinizi tam olarak anlatınız.

 

[emsey]

Bu şekilde deneyebilirsiniz.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
For a = Cells(65536, 3).End(xlUp).Row To 1 Step -1
If Cells(a, "C") = 0 Then Rows(Cells(a, "C").Row).Delete
Next
End Sub

Selamın aleyküm üstad. Ben kısa ve öz olması için senin kodları denedim ancak benim dosyamda işlem hızlı olsun kasmasın diye hücreleri 65536 değilde 1000 yapıyorum ancak 1. satırdan itibaren 0'dan ziyade boş olan hücreleride siliyor. Ben bunu 11. satır ile 1000 arası olarak nasıl revize edebilirim. Birde bu işlem kasmaması için D111000 arasında hücrede 0 olan satırları daha seri ve stabil sildirebileceğimiz başka bir yöntem yok mu?

 

[Muzaffer Ali]

Merhaba.
Aşağıdaki kod daha hızlı çalışır.

Sub test()
    Dim syf As Worksheet
    Dim Bul As Range
    For Each syf In ThisWorkbook.Worksheets
        Do
            Set Bul = syf.Range("D:D).Find(What:="0", LookIn:=xlValues, LookAt:=xlWhole)
            If Bul Is Nothing Then
                Exit Do
            Else
                syf.Rows(Bul.Row).Delete
            End If
        Loop
    Next
    MsgBox "İşlem tamamlandı."
End Sub

 

[asc295]

Sub askm()
Dim son As Long
For Each c In Sheets
    c.Select
    son = c.Range("C" & Rows.Count).End(3).Row
    For i = son To 2 Step -1
        If c.Cells(i, 3) = 0 Then
            Rows(i).Delete
        End If
    Next i
Next
MsgBox "Silme işlemi tamamlandı...", vbInformation, "ASKM"
End Sub

Bu kodu sadece belirli bir çalışma sayfası için nasıl yapabiliriz?

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Sifir_Olan_Satirlari_Sil()
    Dim Son As Long, X As Long, Alan As Range
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    With Sheets("dönüşüm")
        .Select
        Son = .Cells(.Rows.Count, "D").End(3).Row
     
        For X = 2 To Son
            If .Cells(X, 4) = 0 Then
                If Alan Is Nothing Then
                    Set Alan = .Cells(X, "D")
                Else
                    Set Alan = Union(Alan, .Cells(X, "D"))
                End If
            End If
        Next
     
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
    End With
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "Silme işlemi tamamlandı.", vbInformation
End Sub

 

[asc295]

"compile error : sub or function not defined" hatası alıyorum.

 

[Korhan Ayhan]

Doğru uyguladığınızdan emin olunuz.

Sayfa adını kendi dosyanıza göre düzenlemelisiniz.

 

[asc295]

Doğru uyguladığınızdan emin olunuz.

Sayfa adını kendi dosyanıza göre düzenlemelisiniz.

Sayfa adını kendi istediğim sayfa adını yazdım. Ama olmadı.

 

[Korhan Ayhan]

Örnek dosyanızı paylaşır mısınız?