Boşluk sil makroları

[hopeful]

Merhabalar,
Ekli dosyadaki gibi veri tablosunda boşluklar yer almaktadır.
Yeni veri girişleri olacaktır. (Veri tablosu sabit değildir, hem satır hem de sütuna doğru genişlemektedir)

"Satır sil" butonuna basınca sadece satırdaki boşlukları silerek değerleri sol tarafa doğru yan yana sıralayacaktır

"Sütun sil" butonuna basınca da sadece sütundaki boşlukları silerek değerleri yukarı doğru sıralayacaktır.

Satır sil ve Sütün sil makrosu için yardımlarınızı rica ederim.

Saygılarımla,

 

[askm]

Aşağıdaki kodları kullanabilirsiniz.

Sub ASKM_Satir_sil()
Dim SonSatir As Long
SonSatir = Cells(Rows.Count, "A").End(xlUp).Row
For i = SonSatir To 2 Step -1
    If Cells(i, "A") = "" Then
        Rows(i).Delete
    End If
Next i
End Sub

Sub ASKM_Sütun_sil()
Dim SonSutun As Long
SonSutun = Cells(2, 256).End(xlToLeft).Column
For i = SonSutun To 1 Step -1
    If Cells(2, i) = "" Then
        Columns(i).Delete
    End If
Next i
End Sub

 

[hopeful]

Aşağıdaki kodları kullanabilirsiniz.

Sub ASKM_Satir_sil()
Dim SonSatir As Long
SonSatir = Cells(Rows.Count, "A").End(xlUp).Row
For i = SonSatir To 2 Step -1
    If Cells(i, "A") = "" Then
        Rows(i).Delete
    End If
Next i
End Sub

Sub ASKM_Sütun_sil()
Dim SonSutun As Long
SonSutun = Cells(2, 256).End(xlToLeft).Column
For i = SonSutun To 1 Step -1
    If Cells(2, i) = "" Then
        Columns(i).Delete
    End If
Next i
End Sub

Sayın askm,
Satır ya da sütunları komple silmeyecek..
Boşlukları uçurarak satır için değerleri yanyana ; sütun için de değerleri altalta yazacak.
Cevap kısmını da ekli dosyada görebilirsiniz.

 

[Korhan Ayhan]

Alternatif;

Option Explicit

Sub Satir_Sil()
    Dim X As Long, Y As Integer, Son_Satir As Long, Son_Sutun As Integer
    
    Son_Satir = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    Son_Sutun = Cells(1, Columns.Count).End(1).Column
    
    For X = 2 To Son_Satir
        For Y = Son_Sutun To 1 Step -1
            If Cells(X, Y) = "" Then
                Cells(X, Y).Delete Shift:=xlToLeft
            End If
        Next
    Next

    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Sub Sutun_Sil()
    Dim X As Long, Y As Integer, Son_Satir As Long, Son_Sutun As Integer
    
    Son_Satir = Cells.Find("*", Cells(1, 1), , , xlByRows, xlPrevious).Row
    Son_Sutun = Cells(1, Columns.Count).End(1).Column
    
    For X = Son_Satir To 2 Step -1
        For Y = 1 To Son_Sutun
            If Cells(X, Y) = "" Then
                Cells(X, Y).Delete Shift:=xlUp
            End If
        Next
    Next
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[hopeful]

Çok teşekkür ederim Korhan Bey,
İyi günler dilerim...