bir sütunda bulunan hücredeki verilerin Tekrarı yoksa bir alta boş satır açmak

[u.L.a.s]

Merhabalar

Excel çalışma sayfasında diyelim ki c sütununda kod şeklinde tuttuğum aşağıdaki resimdeki gibi veriler olsun



Bu verilerden kimisi her satırda tekrarlıyor kendisini. örneğin 865 den 2 tane var.

şimdi sorum aşağıdaki resimdeki gibi veri altına boş satır açmak. ama birbirini tekrarlayan veriler varsa onun altına satır açmayacak o veri ne zaman tekrarlamıyorsa o zaman boş satırı açacak





bilgi ve yardımlarınızı rica ederim

 

[Saban Sertkaya]

Aşağıdaki kodu deneyiniz.

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("C:C")) Is Nothing Then Exit Sub
If ActiveCell.Offset(-1, 0).Value = "" Then Exit Sub
If ActiveCell.Offset(-1, 0).Value <> Target.Offset(-1, 0).Value Then
ActiveCell.Value = ActiveCell.Offset(-1, 0).Value
ActiveCell.Offset(-1, 0).Value = ""
ActiveCell.Offset(1, 0).Select
End If
End Sub

 

[u.L.a.s]

Bu kodu excelde nasıl çalıştırabilirim

 

[Saban Sertkaya]

Kodu kopyalayın. Excel dosyanızı açın. Aşağıdaki sayfa ismi üzerine fare ile sağ tuş yapın. Kodu görüntüle deyin. Açılan bölümde sağdaki boş beyaz alana fare sağ tuş yapın ve yapıştır deyin.
C sütununda işlemi kontrol edin.
Kolay gelsin.

 

[u.L.a.s]

bunları yapıyorum zaten ama ben bir butona bunu atamak istiyorum olmuyor. normal vba üzerinden play tuşuna basarak kod çalışsın diyorum yine karşıma makro seçim penceresi açılıyor

 

[Ömer BARAN]

Merhaba.
Aşağıdaki kod'u bir DÜĞME'ye atayarak denermisiniz.

Sub kaydır()
son = Cells(Rows.Count, "c").End(3).Row

For i = 2 To son + son

If Range("C" & i - 1) = Range("C" & i) Or Range("C" & i) = "" Or Range("C" & i - 1) = "" Then
    a = i + 1
    
    If Range("C" & a) > 0 And Range("C" & a) <> Range("C" & a + 1) Then
       Range("C" & a + 1).Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    son = son + 1
    End If

End If

Next

Range("C1").Select
MsgBox ("Tamamlandı")
End Sub

 

[Saban Sertkaya]

Siz sanırım önceden girilmiş bir veri için bu işlemi istiyorsunuz. Benim verdiğim kodlar ise anlık veri girişi içindir.

 

[u.L.a.s]

@saban20152015 evet önceden varolan verilerin altına boş satır açılsın istiyorum

@omer.baran
gönderdiğiniz kod çok güzel çalışıyor fakat şöyle bir sorun var

kodu çalıştırınca ilk 2 satırdaki 865 verisi altına boş satır açmıyor.


o iki satırı kaldırıp deneyeyim dedim bu seferde aşağıdaki resimdeki gibi satırların altına boş satır yaratmadı




Diğer bir sorun ise A B D E sütunlarındada verilerim oluyor ben c deki verilerin tekrarlmasını baz alarak boş satır açtırıyorum

fakat A B D E sütunlarında veri varken bu kodu çalıştırınca aşağıdaki gibi görüntü oluyor. yani C sütunundaki verileri aşağıya kaydırıyor.

benim istediğim tamamen yeni boş satırlar açması




yani şu şekilde olmalı

 

[Saban Sertkaya]

Alttaki linkten örnek dosyayı indirerek inceleyebilirsiniz. C sütunundaki veriler baz alınarak boş satır eklenmektedir.
Dosyada kullanılan kodlamada ayrıyeten alttadır. Kolay gelsin.

Sub Düğme1_Tıklat()
For a = [C1048576].End(xlUp).Row To 3 Step -1
If Cells(a, 3).Value <> Cells(a - 1, 3).Value Then Cells(a, 3).EntireRow.Insert Shift:=xlDown
Next a
End Sub

Link:
http://s6.dosya.tc/server/t8hoyr/Bosluk.rar.html

 

[veyselemre]

2.kez çalıştırıldığında tekrar satır açmaması için aşağıdaki şekilde de kullanabilirsiniz.

Sub satirAc()
    For i = Cells(Rows.Count, 3).End(xlUp).Row To 3 Step -1
        If Cells(i, 3).Value <> Empty And Cells(i - 1, 3).Value <> Empty And Cells(i, 3).Value <> Cells(i - 1, 3).Value Then
            Rows(i).Insert Shift:=xlDown
        End If
    Next i
End Sub

 

[u.L.a.s]

Bilginize yüreğinize sağlık. yardımlarınız için çok teşekkür ederim

 

[Saban Sertkaya]

Rica ederim. Hayırlı günler.