Mükerrer bilgiyi aktarmasın.

[unur]

Mrb. Belki çok basit ama yapmadım. Sayfa1'deki B5:H8 arasında ki bazı zamanlarda bir satır bazı zamanlarda 3 satır bilgim var. Buton aracılığı ile 2'inci sayfaya aktarmak istiyorum.
Ancak Sayfa1'deki aktarılacak bilgiler Sayfa2'de varsa kayıt var şeklinde uyarı versin yoksa aktarma yapsın.
Basit Örnek bir dosya ekledim.
Yardımcı olacak arkadaşlara şimdiden teşekkürler.

 

[Necdet]

Merhaba,

Verdiğiniz örneğe göre kod yazılabilir ama veri büyüklüğüne bağlı olarak süre çok uzayabilir. Çünkü tek bir veri yok, örneğin tc no gibi.
Bu durumda sayfa1 deki her ad sayfa2 de aranacak, eşitliği bulunursa bu sefer diğer verilerin eşitliğine bakılacak.
Oysa TC No olsa isteğiniz daha mantıklı olurdu.
Yine de aşağıdaki kodları deneyebilirsiniz.

    Dim i   As Long, _
        j   As Long, _
        k   As Integer, _
        c   As Range, _
        Adr As String, _
        vy  As Boolean
    
    For i = 2 To Sayfa1.Cells(Rows.Count, "A").End(3).Row
    
        vy = False
        Adr = ""
        
        With Sayfa2.Range("B:B")
            Set c = .Find(Sayfa1.Cells(i, "B"), LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    For k = 3 To 6
                        If Sayfa1.Cells(i, k) = Sayfa2.Cells(c.Row, k) Then
                            vy = True
                            Exit Do
                        End If
                    Next k
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
        
        If vy = False Then
            j = Sayfa2.Cells(Rows.Count, "B").End(3).Row + 1
            Sayfa2.Cells(j, "B") = Sayfa1.Cells(i, "B")
            Sayfa2.Cells(j, "C") = Sayfa1.Cells(i, "C")
            Sayfa2.Cells(j, "D") = Sayfa1.Cells(i, "D")
            Sayfa2.Cells(j, "E") = Sayfa1.Cells(i, "E")
            Sayfa2.Cells(j, "F") = Sayfa1.Cells(i, "F")
        Else
            Sayfa1.Cells(i, "G") = "Mükerrer"
        End If
            
    Next i
    MsgBox "İşlem Bitmiştir...."
End Sub

 

[unur]

Kolaylik olmasi acisindan b sutununda tc kimlik no ve e sutunundaki verileri dikkate alsak, nasil bir revize yapabiliriz kodlarda, aslinda isyerinde internet bilgisayarina dosyayi tasiyamadigimdan dosyanin kendisini atamadim.

 

[Necdet]

Kolaylik olmasi acisindan b sutununda tc kimlik no ve e sutunundaki verileri dikkate alsak, nasil bir revize yapabiliriz kodlarda, aslinda isyerinde internet bilgisayarina dosyayi tasiyamadigimdan dosyanin kendisini atamadim.

E sütunundaki veri şehir verisi, şehir farklı olursa aktaracak mı? yoksa uyarı verip duracak mı? tam anlamadım.

 

[unur]

Necdet hocam; işyerindeki dosyamı aktaramadığımdan örnekleme bir şey yaptım, basit bir anlatımla Tc kmlik numarası ve örnek e sütunundaki verileri kontrol etsin varsa diger sayfada veriler var ise daha önce bu veriler aktarılmış diye uyarı verip aktarma yapmasın.
Ben kodları işyerindeki dosyada uygulamaya çalışacağım.
Teşekkürler.

 

[Necdet]

Kodlar zaten bu işi yapıyor, siz sadece arama yapacağınız ve kontrol edeceğiniz sütunları kodlara yansıtacaksınız.
Artık gerisi sizde