• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Koşula bağlı hücre silme ve kaydırma

  • Konbuyu başlatan Konbuyu başlatan eyldrm
  • Başlangıç tarihi Başlangıç tarihi
E

eyldrm

Katılım
7 Mayıs 2014
Mesajlar
7
Excel Vers. ve Dili
2010
Öncelikle merhaba aranıza yeni katıldım.
Soru sormadan önce arama yaptım fakat sorunuma direkt cevap olacak yanıt bulamadım o nedenle konu açmak durumunda kaldım.

Elimde ki sayfada soldan sağa A satırından O satırına kadar yine aynı şekilde yukarıdan aşağı doğru 10704 satır (boşluklar dahil) veri var.

Bu verileri bir başka sayfadan çektirdik ve genel olarak sırasıyla her satırın altında mükerrer kayıtlar mevcut. Çektirilirken mükerrer kayıt çekildiğinde altına bir boşluk bıraktırdık. Biz bu boşluklar için yukarıdan aşağıya olan bütün satırları silip 3 adet hücrenin yukarı çıkmasını sağlamaya çalışıyoruz. (Örnekte görebilirsiniz)

Kısaca yukarıdan aşağıya tarandığı zaman her boş satır bulduğu zaman boş bulduğu satırın altında ki satırdan belirlediğimiz 3 hücreyi yukarı taşıyacak diğer kalan hücreyi silecek ve boş satır kalmayacak.(Örnekte boyadım o kısımları)

Bu mükerrer kayıt olayı çektirilen sayfada ki sıraya göre değerlendirildi.
Yani alt alta olan sırada ki mükerrer kayıtlarda kaç tane alt alta bulduysa bunu +1 arttırarak boşluk bıraktırıldı. Yani gelen sıra ile Alt alta 4 adet Excel yazıyorsa ilk excel'den sonra bir boşluk 2.'den sonra 2 bu böyle kaç tane bulduysa +1 olarak çoğalarak gitti. Yani bizim için mükerrer filtresi sayfa genelinde kaç tane mükerrer excel yazdığı ile ilgili değil var olan sıra ile alt alt gelen verilerde mükerrer isim olup olmadığı ile alakalı bu boşluk durumu.

Örneğe baktığınızda eminim daha iyi anlayacaksınızdır.

Yardımlarınızı esirgemeyeceğinizi umuyorum teşekkürler.

EK'te dosya gönderemiyorum sanırım yeni üye olduğum için o nedenle Dosya.tc isimli dosya paylaşım sitesine ek'ledim 14kb bir excel sayfası.

http://s3.dosya.tc/server22/Szxvtv/satir-sil.xlsx.html
 
eyldrm' Alıntı:
Öncelikle merhaba aranıza yeni katıldım.
Soru sormadan önce arama yaptım fakat sorunuma direkt cevap olacak yanıt bulamadım o nedenle konu açmak durumunda kaldım.

Elimde ki sayfada soldan sağa A satırından O satırına kadar yine aynı şekilde yukarıdan aşağı doğru 10704 satır (boşluklar dahil) veri var.

Bu verileri bir başka sayfadan çektirdik ve genel olarak sırasıyla her satırın altında mükerrer kayıtlar mevcut. Çektirilirken mükerrer kayıt çekildiğinde altına bir boşluk bıraktırdık. Biz bu boşluklar için yukarıdan aşağıya olan bütün satırları silip 3 adet hücrenin yukarı çıkmasını sağlamaya çalışıyoruz. (Örnekte görebilirsiniz)

Kısaca yukarıdan aşağıya tarandığı zaman her boş satır bulduğu zaman boş bulduğu satırın altında ki satırdan belirlediğimiz 3 hücreyi yukarı taşıyacak diğer kalan hücreyi silecek ve boş satır kalmayacak.(Örnekte boyadım o kısımları)

Bu mükerrer kayıt olayı çektirilen sayfada ki sıraya göre değerlendirildi.
Yani alt alta olan sırada ki mükerrer kayıtlarda kaç tane alt alta bulduysa bunu +1 arttırarak boşluk bıraktırıldı. Yani gelen sıra ile Alt alta 4 adet Excel yazıyorsa ilk excel'den sonra bir boşluk 2.'den sonra 2 bu böyle kaç tane bulduysa +1 olarak çoğalarak gitti. Yani bizim için mükerrer filtresi sayfa genelinde kaç tane mükerrer excel yazdığı ile ilgili değil var olan sıra ile alt alt gelen verilerde mükerrer isim olup olmadığı ile alakalı bu boşluk durumu.

Örneğe baktığınızda eminim daha iyi anlayacaksınızdır.

Yardımlarınızı esirgemeyeceğinizi umuyorum teşekkürler.

EK'te dosya gönderemiyorum sanırım yeni üye olduğum için o nedenle Dosya.tc isimli dosya paylaşım sitesine ek'ledim 14kb bir excel sayfası.

http://s3.dosya.tc/server22/Szxvtv/satir-sil.xlsx.html
Genişletmek için tıkla ...

Soruyu Excele yeni başlayanlar bölümüne açmışsınız.
Eğer makrolu çözüm işinizi görürse bu konuda makro yazılabilir.
 
eyldrm' Alıntı:
Yetkili kişiler mümkünse uygun yere taşırsa sevinirim. Uyarınız için teşekkürler.
Genişletmek için tıkla ...

Cevabınızdan makrolu çözüm de olabileceğini anlıyorum.

Mevcut dosyanızda Sayfa1 var ayrıca Sayfa2 sayfası ekleyin ve aşağıdaki kodu bir modül içene koyup çalıştırın.

Kod istenen değeri Sayfa2 ye getiriyor.

Kod: 
Sub veri_al()

sat = Worksheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row + 1

For r = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "e").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "e").Value


If Sheets("Sayfa1").Cells(r, "e").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("E2:E" & r), aranan1) = 1 Then
say = 0

For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "e").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "e").Value

If aranan2 = aranan1 Then
say = say + 1
If say = 1 Then
For j = 1 To 15
Sheets("Sayfa2").Cells(sat, j).Value = Sheets("Sayfa1").Cells(i, j).Value
Next j
Else
Sheets("Sayfa2").Cells(sat, 13).Value = Sheets("Sayfa1").Cells(i, 13).Value
Sheets("Sayfa2").Cells(sat, 14).Value = Sheets("Sayfa1").Cells(i, 14).Value
Sheets("Sayfa2").Cells(sat, 15).Value = Sheets("Sayfa1").Cells(i, 15).Value
End If
sat = sat + 1

End If

Next i

End If
End If
Next r

End Sub
 
halit3' Alıntı:
Cevabınızdan makrolu çözüm de olabileceğini anlıyorum.

Mevcut dosyanızda Sayfa1 var ayrıca Sayfa2 sayfası ekleyin ve aşağıdaki kodu bir modül içene koyup çalıştırın.

Kod istenen değeri Sayfa2 ye getiriyor.

Kod: 
Sub veri_al()

sat = Worksheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row + 1

For r = 2 To Worksheets("Sayfa1").Cells(Rows.Count, "e").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "e").Value


If Sheets("Sayfa1").Cells(r, "e").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("E2:E" & r), aranan1) = 1 Then
say = 0

For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "e").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "e").Value

If aranan2 = aranan1 Then
say = say + 1
If say = 1 Then
For j = 1 To 15
Sheets("Sayfa2").Cells(sat, j).Value = Sheets("Sayfa1").Cells(i, j).Value
Next j
Else
Sheets("Sayfa2").Cells(sat, 13).Value = Sheets("Sayfa1").Cells(i, 13).Value
Sheets("Sayfa2").Cells(sat, 14).Value = Sheets("Sayfa1").Cells(i, 14).Value
Sheets("Sayfa2").Cells(sat, 15).Value = Sheets("Sayfa1").Cells(i, 15).Value
End If
sat = sat + 1

End If

Next i

End If
End If
Next r

End Sub
Genişletmek için tıkla ...

Öncelikle ilginize teşekkürler kodunuz çalıştı.
Fakat tam istediğim olmadı. Sizin kodunuz da İçinde "Halit3" geçen tüm kayıtları alt alta yazdırdı fakat bizim için önemli olan bunların geldiği sıra ile alt alta yazdırılması yani tüm satırları tarayıp "halit3" geçen kayıtları en üstte ilk bulduğu halit3 kelimesinin altına yazdırması bizim verimizi bozuyor. Olması gereken Yukarıdan aşağıya tararken geldiği sıra ile alt alta bulduğu mükrerrer kayıtları alt alta sıralama yapması gerekiyor.
İsterseniz şöyle yapalım veya yapabilirmisiniz, A sütununda rakamlar var 1 onun altında 1 , 2 onun altında 2 mükrerrer kayıtlar bunlar biz bu sıra ile bunları alt alta getirip belirtiğim hücresini silip belirttiğim hücreyi yukarı çıkardığımız zaman istediğimiz sonuca ulaşabiliriz. Eğer mümkünse kodu bu şekilde revize etmenizi rica ediyorum. Umarım anlatabildim.
 
eyldrm' Alıntı:
Öncelikle ilginize teşekkürler kodunuz çalıştı.
Fakat tam istediğim olmadı. Sizin kodunuz da İçinde "Halit3" geçen tüm kayıtları alt alta yazdırdı fakat bizim için önemli olan bunların geldiği sıra ile alt alta yazdırılması yani tüm satırları tarayıp "halit3" geçen kayıtları en üstte ilk bulduğu halit3 kelimesinin altına yazdırması bizim verimizi bozuyor. Olması gereken Yukarıdan aşağıya tararken geldiği sıra ile alt alta bulduğu mükrerrer kayıtları alt alta sıralama yapması gerekiyor.
İsterseniz şöyle yapalım veya yapabilirmisiniz, A sütununda rakamlar var 1 onun altında 1 , 2 onun altında 2 mükrerrer kayıtlar bunlar biz bu sıra ile bunları alt alta getirip belirtiğim hücresini silip belirttiğim hücreyi yukarı çıkardığımız zaman istediğimiz sonuca ulaşabiliriz. Eğer mümkünse kodu bu şekilde revize etmenizi rica ediyorum. Umarım anlatabildim.
Genişletmek için tıkla ...

1 nolu mesajdaki dosyanıza baktım 21-27 satırlardaki değerlerle ilgili A:F sütun arası veriler 1-12 satırdaki verilerle uyumlu ama G:O sütun aralığı verilerde bu uymluluğu göremedim rakamlar tamamen farklı

Siz en iyisi şöyle yapın 50-100 satırlık bir verinizi Sayfa1 e ekleyin ve Sayfa2 ye de olması gerektiği gibi manuel verileri yazın ve dosyanızı ekleyin bir bakalım.
 
halit3' Alıntı:
1 nolu mesajdaki dosyanıza baktım 21-27 satırlardaki değerlerle ilgili A:F sütun arası veriler 1-12 satırdaki verilerle uyumlu ama G:O sütun aralığı verilerde bu uymluluğu göremedim rakamlar tamamen farklı

Siz en iyisi şöyle yapın 50-100 satırlık bir verinizi Sayfa1 e ekleyin ve Sayfa2 ye de olması gerektiği gibi manuel verileri yazın ve dosyanızı ekleyin bir bakalım.
Genişletmek için tıkla ...

Çok daha detaylı açıklamayı çalışmanın içine yaptım.
Dediğiniz gibi iki sayfa açtım şuanda olan ve olması gereken.
Bizim için neyin hangi koşullarda mükerrer olduğunu ve nasıl hücrelerin silinmesi gerektiğini ilginize tekrar tekrar teşekkürler. Aslında ilk yazdığınız kod istediğimizi neredeyse yapıyor sadece biz mükerrer kayıtları süzdürürken bence referansınız A sütunu olmalı çünkü orada 1 den kaç tane varsa onlar kendi arasında mükerrer örneğin A sütununda 45 den kaç tane varsa onlar mükerrer bunlar'dan ilk mükerrer olanı sağ bırakıyoruz kalanının A 'dan L ye kadar olanını öldürüp kalan M-N-O sütunlarında kileri bir yukarı taşıyoruz boşluğu kapatıyoruz. Yani burada ki olay bence mükerrer ararken A sütununda aramak tabi ki takdir sizin siz nasıl isterseniz.
Tekrar tekrar teşekkürler.

http://s3.dosya.tc/server22/D5HxGL/satir-sil-v1.xlsx.html
 
kod:
Kod: 
Sub veri_al()

sat = 1 'Worksheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row + 1

For r = 1 To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "a").Value


If Sheets("Sayfa1").Cells(r, "a").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A1:A" & r), aranan1) = 1 Then
say = 0

For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "a").Value

If aranan2 = aranan1 Then
say = say + 1
If say = 1 Then
For j = 1 To 15
Sheets("Sayfa2").Cells(sat, j).Value = Sheets("Sayfa1").Cells(i, j).Value
Next j
Else
Sheets("Sayfa2").Cells(sat, 13).Value = Sheets("Sayfa1").Cells(i, 13).Value
Sheets("Sayfa2").Cells(sat, 14).Value = Sheets("Sayfa1").Cells(i, 14).Value
Sheets("Sayfa2").Cells(sat, 15).Value = Sheets("Sayfa1").Cells(i, 15).Value
End If
sat = sat + 1

End If

Next i

End If
End If
Next r

End Sub
 
halit3' Alıntı:
kod:
Kod: 
Sub veri_al()

sat = 1 'Worksheets("Sayfa2").Cells(Rows.Count, "A").End(3).Row + 1

For r = 1 To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan1 = Sheets("Sayfa1").Cells(r, "a").Value


If Sheets("Sayfa1").Cells(r, "a").Value <> "" Then
If WorksheetFunction.CountIf(Worksheets("Sayfa1").Range("A1:A" & r), aranan1) = 1 Then
say = 0

For i = r To Worksheets("Sayfa1").Cells(Rows.Count, "a").End(3).Row
aranan2 = Sheets("Sayfa1").Cells(i, "a").Value

If aranan2 = aranan1 Then
say = say + 1
If say = 1 Then
For j = 1 To 15
Sheets("Sayfa2").Cells(sat, j).Value = Sheets("Sayfa1").Cells(i, j).Value
Next j
Else
Sheets("Sayfa2").Cells(sat, 13).Value = Sheets("Sayfa1").Cells(i, 13).Value
Sheets("Sayfa2").Cells(sat, 14).Value = Sheets("Sayfa1").Cells(i, 14).Value
Sheets("Sayfa2").Cells(sat, 15).Value = Sheets("Sayfa1").Cells(i, 15).Value
End If
sat = sat + 1

End If

Next i

End If
End If
Next r

End Sub
Genişletmek için tıkla ...

Ellerinize sağlık tam olması gerektiği gibi çalıştı makronuz.
Yüzeysel verilerin kontrollerini yapacağım fakat sıkıntı olacağını tahmin etmiyorum yanlış getirme veya fazladan silme gibi durumlar olmayacaktır.
Tekrar tekrar çok teşekkürler bu kadar kısa bir sürede anlatılanı doğru anlayıp kodu revize ettiniz.
 
eyldrm' Alıntı:
Ellerinize sağlık tam olması gerektiği gibi çalıştı makronuz.
Yüzeysel verilerin kontrollerini yapacağım fakat sıkıntı olacağını tahmin etmiyorum yanlış getirme veya fazladan silme gibi durumlar olmayacaktır.
Tekrar tekrar çok teşekkürler bu kadar kısa bir sürede anlatılanı doğru anlayıp kodu revize ettiniz.
Genişletmek için tıkla ...

Teşekkürler iyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst