Listemdeki aynı olanların dışındakiler aktarılsın

[Mdemir63]

Selamlar,

Arkadaşlar ekteki dosyamda 1. liste ve 2. liste isimli 2 adet sayfam var. Yapmak istediğim; 1. listeyi kopyalayıp ikinci listenin son dolu hücresinin altından itibaren yapıştırmak istiyorum. Bu zaten olabilecek bir şey ancak 2. listede birinci listede olanları ayıklayarak yapıştırmasını nasıl yapabilirim.Yani listede aynı olanlar mükerrer aktarılmasın bunu nasıl yapabilirim.

Saygılar


Not: mükerrer kayıtlarla ilgili örnekler buldum ama yapamadım.

 

[Mdemir63]

Dosya yı unutmuşum

özür dilerim

 

[N.Ziya Hiçdurmaz]

yanıt

2. Liste sayfa isminin sağında bir boşluk bırakılmış onu kaldırdım.

Sub aktar()
Set l1 = Sheets("1. Liste")
Set l2 = Sheets("2. Liste")
For satl1 = 1 To l1.[n65536].End(3).Row
sonsat = l2.[a65536].End(3).Row
l2.Range("a" & sonsat + 1 & ":o" & sonsat + 1) = l1.Range("a" & satl1 & ":o" & satl1).Value
Next
For sil = l2.[n65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("n1:n" & sil), Range("n" & sil)) > 1 Then
Rows(sil).Delete
End If
Next
End Sub

 

[Mdemir63]

Hocam merhabalar,

İlginize teşekkürler ; Size 2 sorum olacak
1- örnek dosyamda 3 sütun vardı orjinal dosyamda 9 sütun var. onun için kodlarda değişiklik yapacakmıyım?
2- Aşağıdaki kodlarda ben bildiğim yerleri yazdım, diğerlerini siz yazabilirmisiniz?

Saygılar sunarım

Sub aktar()
Set l1 = Sheets("1. Liste") '1. Liste sayfasını l1 olarak tanımla
Set l2 = Sheets("2. Liste") '2. Liste sayfasını l2 olarak tanımla
For satl1 = 1 To l1.[n65536].End(3).Row
sonsat = l2.[a65536].End(3).Row
l2.Range("a" & sonsat + 1 & "" & sonsat + 1) = l1.Range("a" & satl1 & "" & satl1).Value
Next
For sil = l2.[n65536].End(3).Row To 1 Step -1
If WorksheetFunction.CountIf(Range("n1:n" & sil), Range("n" & sil)) > 1 Then
Rows(sil).Delete
End If
Next
End Sub​

 

[Mdemir63]

hocam bu şaşırmış şekilleri nereden çıktı bilmiyorum

 

[Mdemir63]

Hocam şimdi farkettim satırın sonundan itibaren tekrar sanki kopyalıyor gibi. Benim istediğim varolan aynı bilgileri aktarmasın sadece 2. liste sayfasında olan bilgilerin dışındakileri aktarsın istemiştim.

Saygılar

 

[Mdemir63]

Selamlar,
Arkadaşlar bu konu hakkında bilgisi olan varsa cevap verebilirlerse çok memnun olurum.

Saygılar

 

[AS3434]

Sayın komutan63

Dosyayı inceleyin.

 

[Mdemir63]

Hocam merhabalar,

sicile göre aktarma yapıyor değilmi?

Saygılar

 

[AS3434]

Sayın komutan63

Aktarma işlemi şöyle;
1.Liste sayfasını Olduğu gibi 2.Liste sayfasına A sütunu ilk boş satırdan itibaren kopyalıyoruz ve oluşan mükerrer kayıtları silme işlemini 2. Liste sayfasında yapıyoruz.
Daha sonra da Ad, Soyad ve sicile göre sıralıyoruz.

Kodların açıklaması aşağıda.

Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("1. Liste") [COLOR=red]'1. Not[/COLOR]
Set s2 = Sheets("2. Liste")
a = [o65536].End(3).Row  [COLOR=red]'2. Not[/COLOR]
s1.Range("a2:o" & a).Copy  [COLOR=red]' 3. Not[/COLOR]
s2.Select [COLOR=red]'4. Not[/COLOR]
Range("a" & [a65536].End(3).Row + 1).PasteSpecial Paste:=xlPasteValues [COLOR=red]' 5. not[/COLOR]
For sil = [o65536].End(3).Row To 1 Step -1 [COLOR=red]' 6. not[/COLOR]
If WorksheetFunction.CountIf(Range("o2:o" & sil), Range("o" & sil)) > 1 Then[COLOR=red] ' 7. not[/COLOR]
Rows(sil).Delete [COLOR=red]' 8. not[/COLOR]
End If  [COLOR=red]'9. not[/COLOR]
Next [COLOR=red]'10. not[/COLOR]
Range("A2:O" & [a65536].End(3).Row).Sort Key1:=Range("M2"), Order1:=xlAscending, Key2:=Range("N2") _
        , Order2:=xlAscending, Key3:=Range("O2"), Order3:=xlAscending  [COLOR=red]'11. not[/COLOR]
[a:a].ClearContents [COLOR=red]'12. not[/COLOR]
For i = 2 To [m65536].End(3).Row [COLOR=red]'13. not[/COLOR]
If Not Cells(i, 13) = "" Then
sıra = sıra + 1
Cells(i, 1) = sıra
End If
Next i
[a:a].Font.Bold = True [COLOR=red]'14. Not[/COLOR]
[a1].Select
Set s1 = Nothing  [COLOR=red]'15.not[/COLOR]
Set s2 = Nothing
End Sub

NOTLAR
1. Değişken atama.İşlemlerimizde kullanmak için Sayfa ismine değer atıyoruz.ve hafızaya alıyoruz.
2. O sütunu son dolu satır
3. 1. Liste sayfası A2 hücresinden O sütunu son dolu satırına kadar seçiyoruz ve kopyalama işlemini başlatıyoruz.
4. 2. Liste sayfasını seçiyoruz.
5. A sütununda son dolu satırın bir altını seçip "Değerleri Yapıştır" diyoruz.
6. mükerrer kayıtları silmek için döngü başlangıcı
7. Mükerrer kayıtları buluyoruz. Sorgu başlangıcı
Fonksiyonla ifade etmeye çalışırsak =eğer(eğersay(O:O;O2)>1;doğru;yanlı&#351 Gibi
8. Mükerrer kayıtın olduğu satırı sil.
9. Sorgu sonu
10. Döngü devamı. ( O sütunu son satırından ilk satırına kadar devam edecek.
11. A2 den O sütunu son dolu satırı kadar seç, Önce M2 sonra N2 Sonra O2 hücresini kriter alarak artan sıralama yap komutu.
12. Sıra nosunu yeniden vermek için A sütununu temizle
13. 14. Nota kadar olan kodlar A sütununa sıra nosu vermek için kurulan For-Next döngüsüdür.
14. A sütunu yazı tipini Bold yap
15. Değişkenleri hafızadan siliyoruz.



Anlatma yeteneğim fazla yoktur. İfade edemediğim yerler olabilir. Anlayamadığınız yerleri tekrar sormaktan çekinmeyin.

 

[Mdemir63]

Selamlar,

Hocam harika açıklamanız için çok teşekkür ederim.

Saygılar sunarım