Satır Silme(3 sil 1 atla)

[PcRestorer]

Merhabalar bir makro koduna ihtiyacım var ilk 3 satır silinecek 1 atlayacak sonraki 3 satırı silecek 1 atlayacak şeklinde (örnek olarak 8 satırdan 1,2,3, silinecek 4. kalacak 5,6,7 silinecek 8. satır kalacak şeklinde devam edecek)

Yardımlarınız için şimdiden teşekkür ederim

 

[Ömer]

Merhaba,

Satır tamamen mi silinecek yoksa içeriğindeki veri mi silinecek?

.

 

[PcRestorer]

satırlar tamamen silicenek

 

[PcRestorer]

Eğer içindeki veriyi silebilirsem boş satırları silen bir makrom var oda işime yarar

 

[oornek1]

Sub Makro1()
Rows("2:2").Select
Selection.Delete Shift:=xlUp
End Sub

Bu makro işinizi görürmü

 

[PcRestorer]

Malesef ihtiyacım olan 1,2,3 satırlarını silip 4 kalacak 5,6,7 silinecek 8 kalacak ve sonsuz döngü gerekli yaklaşık 500 satırlık bir veriyi temizlemek istiyorum

 

[PcRestorer]

Aşağıdaki makronun sonsuz döngü olmasını istiyorum

Sub MakroTest()

Rows("1:3").Select
Selection.Delete Shift:=xlUp
Rows("2:4").Select
Selection.Delete Shift:=xlUp
Rows("3:5").Select
Selection.Delete Shift:=xlUp
Rows("4:6").Select
Selection.Delete Shift:=xlUp
Rows("5:7").Select
Selection.Delete Shift:=xlUp
Rows("6:8").Select
Selection.Delete Shift:=xlUp
Rows("7:9").Select
Selection.Delete Shift:=xlUp
Rows("8:10").Select
Selection.Delete Shift:=xlUp
Rows("9:11").Select
Selection.Delete Shift:=xlUp
Rows("10:12").Select

End Sub

 

[Seyit Tiken]

Dosyayı bir görseydik.

 

[PcRestorer]

Ekteki dosyada Sütun A daki verilerin süzme sonucunda Sütun B deki gibi olmasını istiyorum Ekli dosyayı görüntüle Satır Süzme.xls

 

[leumruk]

Merhaba,
Aşağıdaki kodu deneyiniz.

Sub Satir_Sil()
Application.ScreenUpdating = False
For x = 1 To Cells(Rows.Count, 1).End(3).Row
Sat = Sat + 1
Range("a" & Sat & ":a" & Sat + 2).Delete shift:=xlUp
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

 

[halit3]

Alternatif kod

Sub Sil()
Application.ScreenUpdating = False
For i = Cells(Rows.Count, "a").End(3).Row - 1 To 1 Step -4
Rows(i & ":" & i - 2).Delete Shift:=xlUp
Next
Application.ScreenUpdating = True
MsgBox "işlem tamam"
End Sub

 

[PcRestorer]

Teşekkürler "leumruk" peki aynı makroyu sütun A'dan L'ye kadar çalıştırabilirmiyiz ?

 

[PcRestorer]

Teşekkürler "halit3" tam istediğim sonucu aldım iyi çalışmalar

 

[leumruk]

Teşekkürler "leumruk" peki aynı makroyu sütun A'dan L'ye kadar çalıştırabilirmiyiz ?

Merhaba,
Aşağıdaki şekilde deneyin.

Sub Satir_Sil()
Application.ScreenUpdating = False
For x = 1 To Cells(Rows.Count, 1).End(3).Row
Sat = Sat + 1
Range("a" & Sat & ":l" & Sat + 2).Delete shift:=xlUp
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

 

[ExcelF1]

Sub Düğme1_Tıklat()
For a = 1 To [A65536].End(xlUp).Row
For b = 3 To 1 Step -1
Rows(a).Delete
Next: Next
End Sub

 

[ordulu82]

Hocam peki bu makroyu nasıl güncelleyebiliriz. yani aynı kodu ben ilk 4 satırı silsin daha sonra 26 satır kalsın, sonra 4 satır silsin 26 satır kalsın şeklinde nasıl düzenleyebiliriz.

 

[leumruk]

Hocam peki bu makroyu nasıl güncelleyebiliriz. yani aynı kodu ben ilk 4 satırı silsin daha sonra 26 satır kalsın, sonra 4 satır silsin 26 satır kalsın şeklinde nasıl düzenleyebiliriz.

Merhaba,
Aşağıdaki gibi deneyin: A sütununu baz alarak kodlamayı düzenledim. Verileriniz hangi sütundaysa siz kodlamayı o sütuna göre düzenleyin.

Sub Sil()
Application.ScreenUpdating = False
Sat = 1
D_Say = WorksheetFunction.CountA(Range("a" & Sat + 3 & ":a" & Rows.Count))
Do While D_Say <> 0
Range("a" & Sat & ":l" & Sat + 3).Delete Shift:=xlUp
Sat = Sat + 26
D_Say = WorksheetFunction.CountA(Range("a" & Sat + 3 & ":a" & Rows.Count))
Loop
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

 

[ordulu82]

Merhaba,
Aşağıdaki gibi deneyin:

Sub Satir_Sil()
Application.ScreenUpdating = False
Sat = 1
For x = 1 To Cells(Rows.Count, 1).End(3).Row
Range("a" & Sat & ":l" & Sat + 3).Delete shift:=xlUp
Sat = Sat + 26
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

Hocam çok teşekkür ederim. tam istediğim gibi olmuş. fakat sizden rica etsem kodun anlamını kısaca açıklayabilirmisiniz. çünkü bazen satırların kayma durumları oluyor. mesela ilk 4 satır yerine 3 satır silinmesi, 26 satır kalması gerekirken 20 satır kalması gereken durumlar oluyor. en azından rakamları değiştirerek kodu güncelleyebileyim.

 

[leumruk]

Merhaba,
17 numaralı mesajı güncelledim. Kodların kenarına açıklamaları ekledim. Kodu kopyalayıp excel dosyanızın vba editörüne yapıştırdığınızda açıklamaları yeşil renkte görebilirsiniz.

 

[ordulu82]

Merhaba,
Aşağıdaki gibi deneyin:

Sub Satir_Sil()
Application.ScreenUpdating = False
Sat = 1 ' hangi satırdan başlayacaksak o numarayı yazıyoruz.
For x = 1 To Cells(Rows.Count, 1).End(3).Row '1'den başlayarak son dolu satıra kadar döngü oluşturuyor. Hangi satırdan başlayacaksanız o numarayı yazacaksınız.
Range("a" & Sat & ":l" & Sat + 3).Delete Shift:=xlUp 'hangi satır aralığını sileceğinizi belirtir. Sat= 1 iken a1:a4 aralığını siler.
Sat = Sat + 26 'Kalmasını istediğiniz satır sayısını Sat tanımına ekliyorsunuz. Her döngüde 26 ekler ve silmeye o satırdan devam eder.
Next
MsgBox "İşlem tamamlanmıştır.", vbInformation, "l e u m r u k"
End Sub

Üstadım çok teşekkür ederim harikasın