Ad ve Tarih eşleştirme..

[kan-nas]

Merhaba,

A ve B kolundaki isim ve tarih ile D koloundaki isim ve tarih olanları J ve k kolonuna yazdırabilir miyiz?

Excelde açıklaması var. İyi çalışmalar.

 

[Civan Jack]

Bir döngü kurup a-b ile d-e sütunlarındakiler birbirine eşitse şartıyla kopyalama yapacaksınız. Bunu siz de yapabilirsiniz Sn. kan-nas.

 

[kan-nas]

Üstad, döngü kurdum ama yapamadım. a1 kolonunda Ali ye bak d1 de varsa yaz ya da b1 kolonnunda 01-01-2013 e bak.E kolunda varsa yaz değil.Bunu ben de yaptım.
A1 kolonunda Ali B1 kolonunda 01-01-2013 varsa bunu D ve E kolounundaki aynı sıradaki Ali ve 01-01-2013 le karşılaştır varsa yaz. Örnekte A ve Bkolonundaki 2. satırdaki ali 01-01-2013 ü D ve E kolonunda 3 sırada bulunan ali ve 01-01-2013 ile eşleştirsin.
Valla yapabilseydim buraya yazmazdım.S. Civan Jack

 

[Necdet]

Merhaba,

Aşağıdaki kodları dener misiniz?

Sub Karsilastir()
    
    Dim i   As Long, _
        j   As Integer, _
        c   As Range, _
        adr As String
    
    Application.ScreenUpdating = False
    
    Range("J2:K" & Rows.Count).Clear
    j = 1
    
    For i = 2 To Cells(Rows.Count, "A").End(3).Row
        With Range("D:D")
            Set c = .Find(Cells(i, "A"), LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                adr = c.Address
                Do
                    If Cells(i, "B") = Cells(c.Row, "E") Then
                        j = j + 1
                        Cells(j, "J") = Cells(i, "A")
                        Cells(j, "K") = Cells(i, "B")
                    End If
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> adr
            End If
        End With

    Next i
    
    If j = 1 Then
        MsgBox "HİÇ KARŞILAŞTIRMA OLMADI....", vbCritical, "excel.web"
    Else
        MsgBox j - 1 & " ADET BENZER KAYIT BULUNDU....", vbInformation, "excel.web"
    End If
    
    Application.ScreenUpdating = True
    
End Sub

 

[Murat OSMA]

Alternatif;

Sub Karsilastir()
    Dim i As Integer, a As Integer
    Dim Rky As Range
    a = 2: Range("J2:K" & Rows.Count).Clear
    For Each Rky In Range("A2:A" & Range("A65536").End(3).Row)
        For i = 2 To Range("D65536").End(3).Row
            If Rky.Value = Cells(i, 4) And _
               Rky.Offset(0, 1).Value = Cells(i, 5) Then
               Rky.Resize(, 2).Copy Cells(a, "J")
               a = a + 1
            End If
        Next i
    Next Rky
    i = Empty: a = Empty
    Set Rky = Nothing
End Sub