• DİKKAT

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

A sütununda boş satırlar ve alfanümerik ile başlayan satırları silmek

Katılım
22 Ekim 2012
Mesajlar
311
Excel Vers. ve Dili
Office 2016 Türkçe
Herkese Merhaba,
İki bin satır ve üzeri olan bir tablom var. Her ay yenileniyor.

Tabloda, A sütununda boş olan satırları,
Alfanümerik ile başlayan satırları ve
H sütununda değeri sıfır olan satırları silmek istiyorum.

Boş satırları silebiliyorum ancak diğer özellikleri ekleyemedim.
Ekli dosyada silinecek satırlar sarıya boyanmıştır. Ayrıca küçük bir bilgi vermek istiyorum.
H sütunundaki değerlerin formatı 000,000.00 böyledir. Bu formata da dönüştürebilir (000.000,00)

Yardımcı olabilecek arkadaşlara şimdiden çok teşekkür ediyorum.
 

Ekli dosyalar

Merhaba.

Aşağıdaki gibi bir kod işinizi görecektir.
Rich (BB code):
Sub Bos_Satir_Sil()
Application.ScreenUpdating = False
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Columns("I:I").Insert Shift:=xlToLeft
With Range("I1:I" & Cells(Rows.Count, "H").End(3).Row)
    .Formula = "=IFERROR(OR(LEN(A1)<>3,0+SUBSTITUTE(SUBSTITUTE(H1,"","",""""),""."","","")=0),TRUE)": .Value = .Value
End With
Range("A1:I" & Cells(Rows.Count, "H").End(3).Row).AutoFilter Field:=9, Criteria1:="DOĞRU"
Range("A1:I" & Cells(Rows.Count, "H").End(3).Row).SpecialCells(xlCellTypeVisible).Delete Shift:=xlUp
Columns("I:I").Delete Shift:=xlToLeft
Application.ScreenUpdating = True
End Sub
 
Ömer Bey Merhaba,

Elinize sağlık sorun yok makro çalışıyor.
Yardımlarınız için çok teşekkür ederim.

Saygılar,
 
Farklı alternatif;

Kod:
Sub Kosullu_Satir_Sil()
    Dim X As Long, Alan As Range
    
    Application.ScreenUpdating = False
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If Cells(X, 1) = "" Or Not IsNumeric(Cells(X, 1)) Or Cells(X, 8) = 0 Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, 1)
            Else
                Set Alan = Union(Alan, Cells(X, 1))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then Alan.EntireRow.Delete xlUp
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub
 
Korhan Bey merhaba,

Elinize sağlık çok teşekkür ederim.
Boş satırları silerken; komple satır boş ise silsin değilse SİLMESİN. olabilir mi acaba?
Bazen E ve H sütununda gerekli bilgi olabiliyor.

Tekrar teşekkür eder saygılar sunarım.
 
Boş satırlar için aşağıdaki kodu deneyiniz.

Kod:
Sub Bos_Satir_Sil()
    Dim X As Long, Alan As Range
    
    Application.ScreenUpdating = False
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountA(Rows(X)) = 0 Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, 1)
            Else
                Set Alan = Union(Alan, Cells(X, 1))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then Alan.EntireRow.Delete xlUp
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub
 
Merhaba Korhan Bey,

Diğer koşullar aynen kalmalı yani ilk yazdığınız kod doğru, sadece
Boş satırları silerken; komple satır boş ise silsin değilse SİLMESİN.

İlginize ve bilginize sağlık.
 
Pardon ben sorunuzu yanlış anlamışım.

Kod:
Sub Kosullu_Satir_Sil()
    Dim X As Long, Alan As Range
    
    Application.ScreenUpdating = False
    
    For X = 1 To Cells(Rows.Count, 1).End(3).Row
        If WorksheetFunction.CountA(Range("A" & X & ":H" & X)) = 0 Or _
            Not IsNumeric(Cells(X, 1)) Or Cells(X, 8) = 0 Then
            If Alan Is Nothing Then
                Set Alan = Cells(X, 1)
            Else
                Set Alan = Union(Alan, Cells(X, 1))
            End If
        End If
    Next
    
    If Not Alan Is Nothing Then Alan.EntireRow.Delete xlUp
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır."
End Sub
 
Korhan Bey Merhaba,

Tam istediğim gibi olmuş sorun yok.
Ömer beye ve size çok teşekkür ederim.
Ellerinize sağlık.

Saygılar.
 
Geri
Üst