• DİKKAT

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

iki sütunda aynı olan kayıtları başka sayfaya kopyalamak

N

necip54

Katılım
4 Eylül 2004
Mesajlar
183
Excel Vers. ve Dili
Excel 2010 Türkçe
İyi günler,
Benzer bir konu işlenirken isteğimi göndermiştim ama dikkatlerden kaçtı galiba diyerek yeni konu başlığıyla tekrar gönderiyorum.

Ekli dosyada görüleceği gibi;
A sütunundaki Poliçe numaraları ile B sütunundaki Poliçe numaralarından bazıları aynı satırda OLMAYACAK şeklide eşleşmektedir. B,C,D,E,F,G,H,I sütunlarındaki veriler aynı satırda aynı poliçeye ait olup başka sayfaya taşınırken birlikte gitmeleri lazım.

İstenilen :
A sütunundaki sayılardan herbiri ile B sütunundaki eşleşen sayıların herbiri ve onların sağında bulunan aynı satırdaki bütün değerleri Sayfa2 ye A2:I2 satırından başlayarak her eşleşeni alt al ta gelecek şekilde aktarmak gerekiyor.(Sayfa2 de gösterilmiştir)
Not:C,D,E,F,G,H,I daki değerler B nin ayrılmaz parçalarıdır.Aktarma işleminde her satırda B,C,D,E,F,G,H,I birlikte aktarılmalıdır.
 

Ekli dosyalar

necip54' Alıntı:
İyi günler,
Benzer bir konu işlenirken isteğimi göndermiştim ama dikkatlerden kaçtı galiba diyerek yeni konu başlığıyla tekrar gönderiyorum.

Ekli dosyada görüleceği gibi;
A sütunundaki Poliçe numaraları ile B sütunundaki Poliçe numaralarından bazıları aynı satırda OLMAYACAK şeklide eşleşmektedir. B,C,D,E,F,G,H,I sütunlarındaki veriler aynı satırda aynı poliçeye ait olup başka sayfaya taşınırken birlikte gitmeleri lazım.

İstenilen :
A sütunundaki sayılardan herbiri ile B sütunundaki eşleşen sayıların herbiri ve onların sağında bulunan aynı satırdaki bütün değerleri Sayfa2 ye A2:I2 satırından başlayarak her eşleşeni alt al ta gelecek şekilde aktarmak gerekiyor.(Sayfa2 de gösterilmiştir)
Not:C,D,E,F,G,H,I daki değerler B nin ayrılmaz parçalarıdır.Aktarma işleminde her satırda B,C,D,E,F,G,H,I birlikte aktarılmalıdır.
Genişletmek için tıkla ...

merhaba
boş bir module kopyalayrak dener misiniz
Kod: 
Option Explicit
Sub aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Aktarıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.DisplayAlerts = False
Sheets("Sayfa2").Range("A2:I65536").ClearContents
kaplan = 2
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A2:A" & ts), _
Sheets("Sayfa1").Cells(ts, "B")) > 0 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa1").Cells(ts, "B")
Sheets("Sayfa2").Cells(kaplan, "B") = Sheets("Sayfa1").Cells(ts, "B")
Sheets("Sayfa2").Cells(kaplan, "C") = Sheets("Sayfa1").Cells(ts, "C")
Sheets("Sayfa2").Cells(kaplan, "D") = Sheets("Sayfa1").Cells(ts, "D")
Sheets("Sayfa2").Cells(kaplan, "E") = Sheets("Sayfa1").Cells(ts, "E")
Sheets("Sayfa2").Cells(kaplan, "F") = Sheets("Sayfa1").Cells(ts, "F")
Sheets("Sayfa2").Cells(kaplan, "G") = Sheets("Sayfa1").Cells(ts, "G")
Sheets("Sayfa2").Cells(kaplan, "H") = Sheets("Sayfa1").Cells(ts, "H")
Sheets("Sayfa2").Cells(kaplan, "I") = Sheets("Sayfa1").Cells(ts, "I")
kaplan = kaplan + 1
End If
Next
Application.DisplayAlerts = True
MsgBox "Aktarım Tamamlandı", vbInformation, "Bitiş"
End Sub
 
İhsan Tank' Alıntı:
merhaba
boş bir module kopyalayrak dener misiniz
Kod: 
Option Explicit
Sub aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Aktarıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.DisplayAlerts = False
Sheets("Sayfa2").Range("A2:I65536").ClearContents
kaplan = 2
For ts = 2 To Sheets("Sayfa1").Cells(65536, "A").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("A2:A" & ts), _
Sheets("Sayfa1").Cells(ts, "B")) > 0 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa1").Cells(ts, "B")
Sheets("Sayfa2").Cells(kaplan, "B") = Sheets("Sayfa1").Cells(ts, "B")
Sheets("Sayfa2").Cells(kaplan, "C") = Sheets("Sayfa1").Cells(ts, "C")
Sheets("Sayfa2").Cells(kaplan, "D") = Sheets("Sayfa1").Cells(ts, "D")
Sheets("Sayfa2").Cells(kaplan, "E") = Sheets("Sayfa1").Cells(ts, "E")
Sheets("Sayfa2").Cells(kaplan, "F") = Sheets("Sayfa1").Cells(ts, "F")
Sheets("Sayfa2").Cells(kaplan, "G") = Sheets("Sayfa1").Cells(ts, "G")
Sheets("Sayfa2").Cells(kaplan, "H") = Sheets("Sayfa1").Cells(ts, "H")
Sheets("Sayfa2").Cells(kaplan, "I") = Sheets("Sayfa1").Cells(ts, "I")
kaplan = kaplan + 1
End If
Next
Application.DisplayAlerts = True
MsgBox "Aktarım Tamamlandı", vbInformation, "Bitiş"
End Sub
Genişletmek için tıkla ...

Çok teşekkür ederim İhsan Bey, denedim ve çok faydalı bir iş oldu, Allah razı olsun
 
İhsan Tank' Alıntı:
rica ederim
Allah Hepimizden Razı Olsun
:yazici:
Genişletmek için tıkla ...

İhsan Bey, bir yerde aksilik oldu ve çözemedim: Dosyanın son şeklini tam listeli olarak yeniden bu mesaja ekledim.

Ekli excel dosyasında Sayfa1 de A sütununda 156 adet poliçe numarası ile B sütunundaki 446 adet poliçe numarasından A da olan adet kadar yani 156 adet poliçe numarasının eşleşip Sayfa2 ye aktarılması gerekir fakat sadece 17 adet poliçe numarası eşleşmiş gibi aktarılmış.Sütunların formatlarını yeniden aynı yaptığım halde 156 adeti eşleştiremiyor. Yani A daki 156 adet poliçe numarasının tamamı B sütunundaki 446 adet poliçe numarasının içinde bir yerlerde gerçekte var fakat nedense eşleşmiyor görünüyor.
 

Ekli dosyalar

necip54' Alıntı:
İhsan Bey, bir yerde aksilik oldu ve çözemedim: Dosyanın son şeklini tam listeli olarak yeniden bu mesaja ekledim.

Ekli excel dosyasında Sayfa1 de A sütununda 156 adet poliçe numarası ile B sütunundaki 446 adet poliçe numarasından A da olan adet kadar yani 156 adet poliçe numarasının eşleşip Sayfa2 ye aktarılması gerekir fakat sadece 17 adet poliçe numarası eşleşmiş gibi aktarılmış.Sütunların formatlarını yeniden aynı yaptığım halde 156 adeti eşleştiremiyor. Yani A daki 156 adet poliçe numarasının tamamı B sütunundaki 446 adet poliçe numarasının içinde bir yerlerde gerçekte var fakat nedense eşleşmiyor görünüyor.
Genişletmek için tıkla ...

merhaba
bunu dener misiniz
Kod: 
Option Explicit
Sub aktar()
Dim ts, kaplan, trabzonspor
trabzonspor = MsgBox("Aktarıma Başlıyorum", vbYesNo, "Onay")
If trabzonspor = vbNo Then Exit Sub
Application.DisplayAlerts = False
Sheets("Sayfa2").Range("A2:I65536").ClearContents
kaplan = 2
For ts = 2 To Sheets("Sayfa1").Cells(65536, "B").End(xlUp).Row
If WorksheetFunction.CountIf(Sheets("Sayfa1").Range("B2:B65536"), _
Sheets("Sayfa1").Cells(ts, "A")) > 0 Then
Sheets("Sayfa2").Cells(kaplan, "A") = Sheets("Sayfa1").Cells(ts, "A")
Sheets("Sayfa2").Cells(kaplan, "B") = Sheets("Sayfa1").Cells(ts, "A")
Sheets("Sayfa2").Cells(kaplan, "C") = Sheets("Sayfa1").Cells(ts, "C")
Sheets("Sayfa2").Cells(kaplan, "D") = Sheets("Sayfa1").Cells(ts, "D")
Sheets("Sayfa2").Cells(kaplan, "E") = Sheets("Sayfa1").Cells(ts, "E")
Sheets("Sayfa2").Cells(kaplan, "F") = Sheets("Sayfa1").Cells(ts, "F")
Sheets("Sayfa2").Cells(kaplan, "G") = Sheets("Sayfa1").Cells(ts, "G")
Sheets("Sayfa2").Cells(kaplan, "H") = Sheets("Sayfa1").Cells(ts, "H")
Sheets("Sayfa2").Cells(kaplan, "I") = Sheets("Sayfa1").Cells(ts, "I")
kaplan = kaplan + 1
End If
Next
Application.DisplayAlerts = True
MsgBox "Aktarım Tamamlandı", vbInformation, "Bitiş"
End Sub
 
İhsan Bey, bu sefer işlem tamam, eşleşenlerin tamamı sayfa 2 ye aktarıldı. Tekrar teşekkür ederim.
 
İhsan Bey, kafanızı ağrıtacağım galiba ama, listeleri birebir kontrol edince şöyle bir durum ortaya çıktı.
Sayfa1 de A ve B sütunlarındaki poliçe numaralarından 156 adet eşleşmiş ve Sayfa2 de bu eşleşen numaralar A ve B sütununa karşılıklı gelecek şekilde yazdırılmış.Buraya kadar tamam; ancak Sayfa1 de A sütunundaki numaralarla eşleşen b sütunundaki numaraların herbirinin sağında olan bilgiler(C,D,E,F,G,H,I sütunlarında AYNI SATIRDA olan bilgiler) eşleşen B dekilere ait olmayan bilgiler yani yukarıdan aşağıya doğru hiç değişmeden sıralanmış.
Örnek:
Sayfa1 deki A2 satırındaki poliçe numarası ile B8 de yazılan poliçe numarası eşleşiyorsa; Sayfa2 de A2 ye sayfa1 den a2 gelmeli(geliyor) ama sayfa1 deki B8 in satırında sağında olan tüm bilgiler(b8,c8,d8,e8,f8,g8,h8,ı8) birlikte gelmeli.Son makroda sayfa1 de eşleşen B deki numarların kendi satırlarındaki sağında kalan bilgiler yerine yukarıdan aşağı bütün satırlar eşleşmeyenlerle birlikte ayıklanmadan aşağı doğru sıralanarak gelmiş. Bu durumda poliçe numaraları a ve b sütunlarında eşleşmiş olarak buluşmuş ama her satırdaki b lerin sağına gelen bilgiler eşleşen b lerin bilgileri değil.

Çok karışık gibi görünüyor ama nasıl olacak bilemiyorum
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst