Makro İle Satır Silme

[ardakose]

Elimde bir araç takip sisteminin oluşturduğu 32000 satırdan oluşan excel listesi mevcut. Ancak sitem listeyi oluştururken 1 dolu 2 boş satır şeklinde oluşturuyor. Filtre uygularken sorun yaşıyorum. 6. satırdan sonra 2 satır silip 1 satır bırakacak şekilde makro yazılabilir mi. Yani 7 8 silinecek 9 duracak 10 11 silinecek 12 duracak. Bu şekilde 32000. satıra kadar bu işlemi gerçekleştirecek bir makro. Teşekkürler.

 

[Korhan Ayhan]

Boş satırları aşağıdaki kod ile silebilirsiniz.

Sub BOŞ_SATIRLARI_SİL()
    Dim Alan As Range, Son As Long
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Son = Cells(Rows.Count, 1).End(3).Row
    On Error Resume Next
    Set Alan = Range("A6:A" & Son).SpecialCells(xlCellTypeBlanks)
    On Error GoTo 0
    If Not Alan Is Nothing Then
        Alan.EntireRow.Delete
        MsgBox "İşleminiz tamamlanmıştır.", vbInformation
    Else
        MsgBox "Boş hücre bulunamadı!", vbInformation
    End If

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
End Sub

 

[Asri]

Elimde bir araç takip sisteminin oluşturduğu 32000 satırdan oluşan excel listesi mevcut. Ancak sitem listeyi oluştururken 1 dolu 2

boş satır şeklinde oluşturuyor. Filtre uygularken sorun yaşıyorum. 6. satırdan sonra 2 satır silip 1 satır bırakacak şekilde makro yazılabilir mi. Yani 7 8 silinecek 9 duracak 10 11 silinecek 12 duracak. Bu şekilde 32000. satıra kadar bu işlemi gerçekleştirecek bir makro. Teşekkürler.

Farklı bir yöntem olarak,


aşağıdaki kod ile boş satırları silebilir siniz.
Range(Cells(i, 1), Cells(i, 100))
1 sayısı 1. kolonu , 100 sayısı 100. kolunu belirtir.

bir satırda 1 ile 100. kolonlar arasında tüm hücreler boş ise silme işlemi yapar.
Bu değerleri değiştirerek alanı daraltıp genişletebilirsiniz.

Sub bos_satir_sil()
 ensonsatir = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 For i = ensonsatir To 7 Step -1
      j = WorksheetFunction.CountA(Range(Cells(i, 1), Cells(i, 100)))
      If j = 0 Then Rows(i).Delete
 Next i
End Sub