Verilen boşlukların sayısı, aynı kayıtların sayısını 9 a tamamlamalı

[hakangon]

Merhaba,

Aşağıdaki koda ekleme yaparak şunu yapmak istiyorum fakat doğru yolu bulamadım;

kontrol edilen 2 hucre değeri eşit ise sayacı 1 arttır,

eşit değil ise ; 9 - sayacın değeri kadar satır ekle

yani ekleyeceğim bos satır sayısı aynı değer içeren satırların sayısına göre belirlenecek ve aynı değerli dolu satır + bos satır toplamı her dongude 9 satır olacak

Simdiden teşekkürler..


Sub çift_kayıtlari_arala()
totalrows = ActiveSheet.UsedRange.Rows.Count
For Row = totalrows To 2 Step -1
If Cells(Row, 1).Value <> Cells(Row - 1, 1).Value Then Rows(Row).Insert
Next Row
End Sub

 

[ÖmerFaruk]

Sub çift_kayıtlari_arala()
totalrows = ActiveSheet.UsedRange.Rows.Count
For x = totalrows To 2 Step -1
    If Cells(x, 1).Value = Cells(x - 1, 1).Value Then
        sayac = sayac + 1
    Else
    Range("A" & x).EntireRow.Resize(9 - sayac - 1).Insert Shift:=xlDown
    sayac = 0
    End If
Next x
End Sub

 

[hakangon]

Sub çift_kayıtlari_arala()
totalrows = ActiveSheet.UsedRange.Rows.Count
For x = totalrows To 2 Step -1
    If Cells(x, 1).Value = Cells(x - 1, 1).Value Then
        sayac = sayac + 1
    Else
    Range("A" & x).EntireRow.Resize(9 - sayac - 1).Insert Shift:=xlDown
    sayac = 0
    End If
Next x
End Sub

Hocam teşekkür ederim,

Range ile başlayan satırda hata veriyor, nedenini anlayamadım.

Bende şöyle bir şey yazdım, çalışıyor, ama x için gerekli değer dinamik olmadı. sizinkinde daha uygun görünüyor.

Tekrar teşekkürler.



Sub Deneme()

Dim x As Integer
Dim sayac As Integer

sayac = 1

For x = 1 To 100

If Cells(x, 1).Value = Cells(x + 1, 1).Value Then

sayac = sayac + 1

Else


For a = 1 To (9 - sayac)

Cells(x + 1, 1).EntireRow.Insert

Next

a = 1
x = x + (9 - sayac)
sayac = 1

End If

Next

End Sub