Belirtilen Hücreler Boş İse Satır Sil

darkgod · 31 Temmuz 2015

Merhaba,

Örneğin: C,D,E,F hücreleri hepsi birden boş ise o satırı silmek istiyorum. Eğer bir tanesi bile dolu olsa silmemeli.

Yani özetle: C2-D2-E2-F2 hücreleri hepsi boş ise C2 satırını sil.

2'den 8040 satırına kadar yukarıdan aşağı doğru taratarak belirlediğim hücrelerin hepsi boş ise tüm satırı sil.

Tabi bunu sürekli değiştirmem için bazen daha fazla hücre eklemem gerektiğinden hangi satırı değiştirmem gerektiğini lütfen belirtin.

Bilgili kişilerin yardımını rica ediyorum. Teşekkürler.

Murat OSMA · 31 Temmuz 2015

Bu kodları kullanabilirsiniz;

Kod:

[FONT="Trebuchet MS"][SIZE="2"]Sub Emre()
    Dim i%
    Application.ScreenUpdating = [COLOR="Red"]False[/COLOR]
    [COLOR="Red"]For [/COLOR]i [COLOR="red"]= [/COLOR]Range("C65536").End([COLOR="Red"]3[/COLOR]).Row [COLOR="red"]To [/COLOR]2 [COLOR="red"]Step [/COLOR]-1
        [COLOR="red"]If [/COLOR]Cells(i, 3) = "" [COLOR="red"]And [/COLOR]Cells(i, 4) = "" [COLOR="red"]And [/COLOR]_
            Cells(i, 5) = "" [COLOR="red"]And [/COLOR]Cells(i, 6) = "" [COLOR="red"]Then[/COLOR]
            Rows(i).Delete
       [COLOR="red"] End If[/COLOR]
    [COLOR="red"]Next [/COLOR]i
    Application.ScreenUpdating = [COLOR="red"]True[/COLOR]
    i = Empty
End Sub[/SIZE][/FONT]

darkgod · 31 Temmuz 2015

Murat OSMA' Alıntı:
Bu kodları kullanabilirsiniz;

Murat Bey,

İlginize teşekkür ederim.
Önerdiğiniz kodları kullanmayı 3 kere denedim ve her seferinde excel yanıt vermedi.

Korhan Ayhan · 1 Ağustos 2015

Merhaba,

Satır silme işlemini tek tek yerine topluca yaparsanız kodlar biraz daha hızlı sonuç verecektir.

Deneyiniz. Kodu dosyanızda ki veriye göre revize etmek gerekebilir.

Kod:

Option Explicit

Sub Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 2 To Son
            If WorksheetFunction.CountBlank(Range("C" & X & ":F" & X)) = 4 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "C")
                Else
                    Set Alan = Application.Union(Alan, Cells(X, "C"))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

darkgod · 3 Ağustos 2015

Korhan Ayhan' Alıntı:

Merhaba,

Satır silme işlemini tek tek yerine topluca yaparsanız kodlar biraz daha hızlı sonuç verecektir.

Deneyiniz. Kodu dosyanızda ki veriye göre revize etmek gerekebilir.

Kod:

Option Explicit

Sub Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 2 To Son
            If WorksheetFunction.CountBlank(Range("C" & X & ":F" & X)) = 4 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "C")
                Else
                    Set Alan = Application.Union(Alan, Cells(X, "C"))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Merhaba Korhan Bey

Çok hızlı şekilde çalıştı ve istediğimi yaptı. Çok teşekkür ederim.
Başka sütunlar için kodun hangi sütun aralığı veya tek sütun için nereleri değiştirmek gerek ?

Korhan Ayhan · 3 Ağustos 2015

Aşağıdaki satır C ile F sütunları arasının boş olup/olmadığını kontrol eder;

Kod:

 If WorksheetFunction.CountBlank(Range("[COLOR="Red"]C[/COLOR]" & X & ":[COLOR="red"]F[/COLOR]" & X)) = 4 Then

Aşağıdaki satırlar ise silinecek alanı belirler;

Satır komple silindiği için kırmızı bölüme hangi sütun harfini yazdığınız önemli değildir. Eğer satır yerine hücre silinseydi bu harf önem taşıyacaktı.

Kod:

Set Alan = Cells(X, "[COLOR="red"]C[/COLOR]")
Set Alan = Application.Union(Alan, Cells(X, "[COLOR="red"]C[/COLOR]"))

darkgod · 3 Ağustos 2015

Korhan Ayhan' Alıntı:
Aşağıdaki satır C ile F sütunları arasının boş olup/olmadığını kontrol eder;

Kod:

If WorksheetFunction.CountBlank(Range("[COLOR="Red"]C[/COLOR]" & X & ":[COLOR="red"]F[/COLOR]" & X)) = 4 Then

Aşağıdaki satırlar ise silinecek alanı belirler;

Satır komple silindiği için kırmızı bölüme hangi sütun harfini yazdığınız önemli değildir. Eğer satır yerine hücre silinseydi bu harf önem taşıyacaktı.

Kod:

Set Alan = Cells(X, "[COLOR="red"]C[/COLOR]") Set Alan = Application.Union(Alan, Cells(X, "[COLOR="red"]C[/COLOR]"))

Çok teşekkür ederim. İlginiz için.

Kolay gelsin.

darkgod · 3 Ağustos 2015

Korhan Ayhan' Alıntı:
Aşağıdaki satır C ile F sütunları arasının boş olup/olmadığını kontrol eder;

Kod:

If WorksheetFunction.CountBlank(Range("[COLOR="Red"]C[/COLOR]" & X & ":[COLOR="red"]F[/COLOR]" & X)) = 4 Then

Aşağıdaki satırlar ise silinecek alanı belirler;

Satır komple silindiği için kırmızı bölüme hangi sütun harfini yazdığınız önemli değildir. Eğer satır yerine hücre silinseydi bu harf önem taşıyacaktı.

Kod:

Set Alan = Cells(X, "[COLOR="red"]C[/COLOR]") Set Alan = Application.Union(Alan, Cells(X, "[COLOR="red"]C[/COLOR]"))

Korhan Bey mesela I ile M arasını kontrol etmek istiyorum yani 5 sütun ama silmiyor.

Acaba bu kodu sadece 4 sütun için mi ayarladınız ? Veya şu 4 rakamı onu mu ifade ediyor ?

Kod:

 If WorksheetFunction.CountBlank(Range("[COLOR="Red"]C[/COLOR]" & X & ":[COLOR="red"]F[/COLOR]" & X)) =[U][B] 4[/B][/U] Then

Yani her seferinde farklı sütun aralığı sayısını kontrol ettireceğim ve bu belli değil ama ardışık gidecek.

Tekrar yardımcı olursanız sevinirim.

Korhan Ayhan · 3 Ağustos 2015

Evet doğru tespit etmişsiniz. 4 rakamı sütun sayısını ifade ediyor.

darkgod · 6 Ağustos 2015

Korhan Ayhan' Alıntı:
Evet doğru tespit etmişsiniz. 4 rakamı sütun sayısını ifade ediyor.

Merhaba

Kusura bakmayın geç dönüş yapıyorum.

Çok teşekkür ederim.

Hoşça Kalın.

Srcn35 · 15 Eylül 2015

Eğer A B C ve D satırları boş ise silmesi için bu kodda hangi değişiklikleri yapmam gerekli birde bu kodu sütunlar için nasıl değiştirip uyarlarız.
Teşekkür ederim.

Korhan Ayhan · 16 Eylül 2015

A-B-C-D sütunlarındaki hücreler için aşağıdaki gibi deneyiniz...

Kod:

Option Explicit

Sub Satir_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 2 To Son
            If WorksheetFunction.CountBlank(Range("A" & X & ":D" & X)) = 4 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "A")
                Else
                    Set Alan = Application.Union(Alan, Cells(X, "A"))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Boş sütunlar içinde aşağıdaki kodu deneyebilirsiniz.

Kod:

Option Explicit

Sub Sutun_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Column
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 1 To Son
            If WorksheetFunction.CountBlank(Columns(X)) = Rows.Count Then
                If Alan Is Nothing Then
                    Set Alan = Columns(X)
                Else
                    Set Alan = Application.Union(Alan, Columns(X))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireColumn.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Srcn35 · 16 Eylül 2015

Çok Teşekkürler

Yazdığınız kodlar için çok teşekkür ederim ancak hem satırları hemde sütunları silemedim iki kodu da birleştirmeye çalıştım ancak yapamadım bu iki özelliği birleştirme imkanımız var mı acaba? birde sütun silmede tamamı boşsa çalışıyor örneğin bunu sadece 2. satırları boş olanları tamamen silmesi için ayarlayabilirmiyiz?

Korhan Ayhan · 16 Eylül 2015

Sorularınızı sorarken lütfen isteklerinizi net olarak belirtin. Tekrar tekrar kod yazmak zorunda kalıyoruz.

Aşağıdaki gibi deneyin.

Kod:

Option Explicit

Sub Bos_Satir_Sutun_Sil()
    Satir_Sil
    Sutun_Sil
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Satir_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 2 To Son
            If WorksheetFunction.CountBlank(Range("A" & X & ":D" & X)) = 4 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "A")
                Else
                    Set Alan = Application.Union(Alan, Cells(X, "A"))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireRow.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Sub Sutun_Sil()
    Dim X As Long, Son As Long, Alan As Range
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Column
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 1 To Son
            If Len(Cells(2, X)) = 0 Then
                If Alan Is Nothing Then
                    Set Alan = Columns(X)
                Else
                    Set Alan = Application.Union(Alan, Columns(X))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireColumn.Delete
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Srcn35 · 17 Eylül 2015

teşekkür ederim

kodlara sizin gibi hakim olmadığım için bir bakışta olup olmayacağını anlayamıyorum bilgisiz olduğum için özür dilerim. olur diye düşünmüştüm yorduysam ve sinirlendirdiysem üzgünüm .

mrwarrior · 17 Eylül 2015

Acaba toplu satır gizleme de hızlı bir şekilde yapabilir mi? 1000 satırlık bir dosyam var. tek tek satır kontrol ediyor. satır gizleme için. oda yaklaşık 1 dk alıyor

daha hızlısı olabilir mi?

mrwarrior · 17 Eylül 2015

Kod:

DOLUSAYISI = Application.WorksheetFunction.CountA(Range("B7:B1006"))

  
    For i = 6 To DOLUSAYISI * 25 + 6
        ver = Join(Application.Index(Range(Cells(i, "G"), Cells(i, "HS")).Value, 0, 0), "")
        ver2 = Join(Application.Index(Range(Cells(i, "B"), Cells(i, "C")).Value, 0, 0), "")
        If ver = "" And ver2 = "" Then Rows(i).Hidden = True
    Next i
    Rows(DOLUSAYISI * 25 + 7 & ":" & 1006).Hidden = True
    

    For i = 12 To 263
        Select Case i
        Case 12 To 41, 49 To 78, 86 To 115, 123 To 152, 160 To 189, 197 To 226, 234 To 263 
           Columns(i).Hidden = True
        End Select
   Next i
        For i = 5 To 263
            If Cells(2, 1).Value > Cells(5, i).Value Or Cells(2, 4).Value < Cells(5, i).Value Then Columns(i).Hidden = True
    Next i

bu şekilde kodum var. DOLUSAYISI 1000 satıra kadar uzuyor. oda çok uuzun sürüyor acaba kısa yolu var mı?

Korhan Ayhan · 18 Eylül 2015

Dosyanızı ekler misiniz?

Ömer BARAN · 18 Eylül 2015

mrwarrior' Alıntı:
Acaba toplu satır gizleme de hızlı bir şekilde yapabilir mi? 1000 satırlık bir dosyam var. tek tek satır kontrol ediyor. satır gizleme için. oda yaklaşık 1 dk alıyor daha hızlısı olabilir mi?

Merhaba Sayın mrwarrior.
Alt tarafta kod'u kullanacağınız sayfa adına fareyle sağ tıklayıp vba ekranını açın. Sağ taraftaki alana aşağıdaki kodları yapıştırın.

Sonra, sayfaya iki adet düğme/şekil ekleyin.

Bunlardan birine fareyle sağ tıklayıp "Makro Ata"yı seçin ve açılan ekranda "gizle" adlı kod'u seçip işlemi tamamlayın. Aynı işlemi diğer şekil/düğme için de yapın ve bu kez "göster adlı kod'u seçerek işlemi tamamlayın.

Artık bu iki düğme ile gizle/göster işlemini yapabilirsiniz.

Varsayımlar:
-- Sayfanın 1'inci satırının BAŞLIK satırı olduğu, verilerin 2'nci satırdan başladığı,
-- Dolu / boş kontrolünde B sütununun kullanılacağı (kontrol başka sütunda yapılacaksa mavi renkli B karakterlerini ilgili sütun adı ile değiştiriniz)
düşünülmüştür.

Kod:

[B][COLOR="red"]Sub gizle()[/COLOR][/B]
Application.ScreenUpdating = False
Application.Calculation = xlManual
Zaman = Timer
son = [[B][COLOR="Blue"]B[/COLOR][/B]65536].End(3).Row
ilkbos = 1
ilkdolu = 1

For gizli = 2 To son
If Range("[B][COLOR="blue"]B[/COLOR][/B]" & ilkbos).End(xlDown).Row = son Then GoTo 10
If Cells(ilkbos + 1, 2) = "" Then
ilkbos = ilkbos - 1
End If
ilkbos = Range("[B][COLOR="blue"]B[/COLOR][/B]" & ilkbos).End(xlDown).Row
ilkdolu = Range("[B][COLOR="blue"]B[/COLOR][/B]" & ilkbos).End(xlDown).Row - 1
        Rows(ilkbos + 1 & ":" & ilkdolu).EntireRow.Hidden = True
ilkbos = ilkdolu + 1
If ilkbos = son Or ilkbos > son Then GoTo 10
Next
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
10
MsgBox "İşlem ; " & Format(Timer - Zaman, "0.000") & " saniye sürdü."
[B]End Sub[/B]

[B][COLOR="Red"]Sub göster()[/COLOR][/B]
son = [[B][COLOR="blue"]B[/COLOR][/B]65536].End(3).Row
Rows(2 & ":" & son).EntireRow.Hidden = False
[B]End Sub[/B]

Ben yukarıdaki kodları 1250 satırlık (dağınık şekilde toplam 550 satırı boş olan) belgede denediğimde 1 saniyenin altında sonuç aldım.
Umarım işinize yarar.

Korhan Ayhan · 18 Eylül 2015

Aşağıdaki kodu deneyiniz.

Kod:

Sub Satir_Gizle()
    Dim X As Long, Son As Long, Alan As Range
    Dim Sutun_Ilk As Integer, Sutun_Son As Integer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Cells.EntireColumn.Hidden = False
    Cells.EntireRow.Hidden = False
    
    Sutun_Ilk = Range("B2")
    Sutun_Son = Range("C2")
    
    On Error Resume Next
    Son = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    On Error GoTo 0
    
    If Son > 1 Then
        For X = 6 To Son
            If Evaluate("=SUM(LEN(" & Range(Cells(X, Sutun_Ilk), Cells(X, Sutun_Son)).Address & "))") = 0 Then
                If Alan Is Nothing Then
                    Set Alan = Cells(X, "A")
                Else
                    Set Alan = Application.Union(Alan, Cells(X, "A"))
                End If
            End If
        Next
    
        If Not Alan Is Nothing Then Alan.EntireRow.Hidden = True
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Belirtilen Hücreler Boş İse Satır Sil

darkgod

Murat OSMA

Altın Üye

darkgod

Korhan Ayhan

Administrator

darkgod

Korhan Ayhan

Administrator

darkgod

darkgod

Korhan Ayhan

Administrator

darkgod

Srcn35

Korhan Ayhan

Administrator

Srcn35

Korhan Ayhan

Administrator

Srcn35

mrwarrior

mrwarrior

Korhan Ayhan

Administrator

Ömer BARAN

Uzman

Korhan Ayhan

Administrator