Son Satırın Değişmesi

[SadiSerdari]

Arkadaşlar aşağıdaki kodla üst satırla alt satırdaki değeri karşılaştırıp eşit değilse; satır boşluğu oluşturuyorum. Ancak oluşan satır boşlukları sonucu haliyle son satır numarası da değişiyor. Bu durumda işlemden tam sonuç alamıyorum. Kodu nasıl düzenleyebilirim. Yardımcı olabilirseniz. Sevinirim.

Sub rowsSplit()
    endRows = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To endRows
        aranan1 = InStr(1, Cells(i, 1), "/", vbTextCompare)
        aranan2 = InStr(1, Cells(i + 1, 1), "/", vbTextCompare)
        iValue1 = Mid(Cells(i, 1), 1, aranan1 - 1)
        iValue2 = Mid(Cells(i + 1, 1), 1, aranan2 - 1)
        
        If iValue1 <> iValue2 Then
            Range(Cells(i + 1, 1), Cells(i + 1, 4)).Insert Shift:=xlDown
            i = i + 1
        End If
    Next
End Sub

 

[mancubus]

tahminen yazıyorum bunu...

        If iValue1 <> iValue2 Then
            Rows(i + 1).Insert
        End If

 

[Necdet]

Merhaba,

Bende tahmini yazıyorum.

Döngüyü sondan başa doğru kurun.

 

[antonio]

Bende tahminen yazıyorum
son satırı tanımlayan "endRows" değişkenini bir kez de döngünün içine yazın.

Sub rowsSplit()
    endRows = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To endRows
        aranan1 = InStr(1, Cells(i, 1), "/", vbTextCompare)

kısmını,

Sub rowsSplit()
    endRows = Cells(Rows.Count, 1).End(xlUp).Row
    For i = 1 To endRows
    endRows = Cells(Rows.Count, 1).End(xlUp).Row
        aranan1 = InStr(1, Cells(i, 1), "/", vbTextCompare)

olarak değiştirin.

 

[mancubus]

necdet bey'in önerdiği gibi, ki tüm nesne silme işlemlerinde böyle yapmak, döngüyü sondan başa (burada son satırdan ilk satıra doğru) çalıştırmak lazım.

yani For i = endRows To 1 Step -1 şeklinde...

 

[mancubus]

ben 2 no.lu mesajımda boş satır eklenecek gibi düşünerek kodu kısalttım.

ama sadece ilk 4 sütundaki veriler 1 satır aşağı kaydırılacak ise ilk mesajdaki satırı muhafaza etmek lazım.

 

[mancubus]

aynı soru burada da sorulmuş.

http://www.excelvba.net/viewtopic.php?t=15658&f=4

diğer forumlarda da aynı soruyu sorduğunuz takdirde bunu ilk mesajınızda belirtmeniz ilgili forumun linkini kopyalamanız cevap verenlerin belki de diğer forumda çözüm üretilmiş bir hususta vakit harcamalarını engelleyecektir.

"soru" forumlarında "cross posting" olarak geçer. çapraz mesaj gibi tercüme edebiliriz.

 

[SadiSerdari]

Arkadaşlar hepinizin ilgi ve alakasına Teşekkürler. Müsait olmadığım için ancak şimdi mesajlarınıza bakabildim. Verdiğiniz kodlar benim dosya eklemediğim için afaki oldu tabi bu benden kaynaklanan durum. Özür Dilerim. Dosyayı ekliyorum. Yardımcı olabilirseniz sevinirim. Dosyadaki veriler netcaddeki noktalarının koordinatları ve karışık geliyor. Karmaşıklığı engellemek için yapmak istedim.

 

[SadiSerdari]

Arkadaşlar anlamadığım şey şu sonsatır değeri artmasına rağmen 1310ncu satırda işlemden tamamen çıkıyor. Sebebi ne olablir acaba.

 

[mancubus]

Sub rowsSplit()
    endRows = Cells(Rows.Count, 1).End(xlUp).Row
    For i = endRows To 2 Step -1
        aranan1 = InStr(Cells(i, 1), "/")
        aranan2 = InStr(Cells(i - 1, 1), "/")
        iValue1 = Mid(Cells(i, 1), 1, aranan1 - 1)
        iValue2 = Mid(Cells(i - 1, 1), 1, aranan2 - 1)
        If iValue1 <> iValue2 Then
            Range(Cells(i, 1), Cells(i, 4)).Insert Shift:=xlDown
        End If
    Next
End Sub

not: 7 no.lu mesajımı gözden geçirin derim.

 

[SadiSerdari]

Sayın mancubus; size ve diğer yardımcı olan arkadaşlara ilgilerinden dolayı teşekkür ederim. Hatırlatmanızı dikkate alacağım. Saygılar.

 

[mancubus]

rica ederim.
işe yaradığına memnun oldum.