Hızlıca boş satır silme

[y_yilmaz1977]

Sub aaa()
Dim satır As Long

satır = Range("A10:A" & Rows.Count).Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'MsgBox satır
i = 1500
Do While i >= satır + 1
Rows(i - 1).Select
Selection.Delete Shift:=xlToLeft
i = i - 1
Loop

End Sub​

Merhabalar;

Yukarıdaki kodda A sütunundaki en son veri olan hücreden sonra 1500. satıra kadar olan boş satırları sildirebiliyorum. Fakat bu işlemi satır satır yaptığından çok uzun sürüyor.

İstiyorum ki A sütunundaki en son veriyi bulsun. Bir sonraki boş satıra geçsin ve 1500. satıra kadar olan bütün boş satırları aynı anda seçsin ve silme işlemini tek seferde hızlıca yapsın.

Aynı işlemi şu kodla da yapıyorum ama bu da benzer. satır satır yapıyor.

sub bossatır ()

Dim k, say As Long

say = Range("B10:B" & Rows.Count).Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

k = 1500

Do While k >= say

If Cells(k, 1).Value = "" Then

Cells(k, 1).Select

Selection.EntireRow.Select

Selection.Delete Shift:=xlToLeft

End If

end sub
​

Makro kaydı ile yapmaya çalıştım.Fakat A sütunundaki en son dolu hücre farklı çalışmalarda değişeceğinden çözüm olmadı.

Sub ccc()
'
'
'

Range("A10").Select
Selection.End(xlDown).Select
Rows("686:1500").Select
End Sub
​

boyalı kısımdaki 686 rakamını farklı durumlara nasıl uyarlayabilirim.

 

[halit3]

bunu denermisiniz.

Sub sil()
sonsat = Cells(Rows.Count, "A").End(3).Row + 1
Rows(sonsat & ":" & 1500).Delete Shift:=xlUp
MsgBox "işlem tamam"
End Sub

 

[Ömer]

Merhaba,

Alternatif olsun..

Sub Sil()
On Error Resume Next
son = [A1500].End(3).Row
    Range("A1:A" & son).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

.

 

[y_yilmaz1977]

Halit bey olmadı ama verdiğin kod üzerinde biraz çalışırsam benim tabloma uyarlayabilirim sanırım.

 

[halit3]

A sütunundaki en son veri olan hücreden sonra enson veri "sonsat"


İstiyorum ki A sütunundaki en son veriyi bulsun.

Bir sonraki boş satıra geçsin bir sonraki boş satır Cells(Rows.Count, "A").End(3).Row + 1

buradan sonra zaten bütün satırlar boş

ve 1500. satıra kadar olan bütün boş satırları aynı anda seçsin burada bu işlem yapılıyor Rows(sonsat & ":" & 1500).Delete Shift:=xlUp

ve silme işlemini tek seferde hızlıca yapsın.


1 nolu mesajındaki söylediğin işlemi yapıyor bu kod

Sub sil()
sonsat = Cells(Rows.Count, "A").End(3).Row + 1
Rows(sonsat & ":" & 1500).Delete Shift:=xlUp
MsgBox "işlem tamam"
End Sub

 

[y_yilmaz1977]

Ömer Bey ve Halit bey ; ikinizin kodundan faydalanarak aşağıdaki kodu oluşturdum. İşlem tamam.

Halit bey 1500. satırdan sonra da veri olduğu için sizin kodunuz bana tam uymadı.

Sub sil ()


son = [A1500].End(3).Row

Rows(son & ":" & 1500).Select

Selection.Delete Shift:=xlToLeft

End Sub​

Teşekkürler...

 

[halit3]

iyi çalışmalar