• DİKKAT

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

Üç Sütunu Karşılaştırma

  • Konbuyu başlatan Konbuyu başlatan steppe
  • Başlangıç tarihi Başlangıç tarihi
Katılım
7 Ağustos 2011
Mesajlar
319
Excel Vers. ve Dili
2003-2010 Türkçe
İyi akşamlar Arkadaşlar,
Epeyce araştırma yaptım fakat benim istediğim örneği bulamadım. Sayfa 2 ve sayfa 4 'teki üç sütunu karşılaştırıp aynı ise Sayfa 4'teki verileri Sayfa 2'ye kopyalamak istiyorum.
Yardımlarınız için şimdiden teşekkür ederim.
 

Ekli dosyalar

Merhaba;
Eki deneyin.
İyi çalışmalar.
 

Ekli dosyalar

muygun Hocam,
Yardımlarınız için çok teşekkür ederim.Sadece eşleşen verileri çekmek mümkün mü? Eşleşmeyen veriler aynı kalsın.
 
Merhaba;
Sayfa2 de C ve F sütunlarını sildiriyordum.
Bunu iptal edersek sanırım istediğiniz olur.
İyi çalışmalar.
 

Ekli dosyalar

Merhaba,
Yardımlarınız için teşekkür ederim.
İyi çalışmalar.
 
Merhaba Arkadaşlar,
Yukarıdaki üç sütunu karşılaştırma kodu oldukça güzel çalışıyor, yalnız oldukça yavaş.Elimde daha önce bulduğum iki sütunu karşılaştırma ile ilgili bir kod var.Bunu üç sütuna göre nasıl uyarlayabiliriz.
"Sayfa 2 ve sayfa 4 'teki üç sütunu karşılaştırıp aynı ise Sayfa 4'teki verileri Sayfa 2'ye sadece eşleşen satırlardaki verileri (örnek sayfadaki gibi)kopyalama"

Sub uc_sutunu_karsilastirma()
Dim i As Long, sat1 As Long, sat2 As Long, k As Range
Sayfa2.Select
Sayfa2.Range("C2:C" & Cells(Rows.Count, "B").End(xlUp).Row).Clear
Sayfa2.Range("C2:C" & Rows.Count & ",E2:E" & Rows.Count).Clear
Application.ScreenUpdating = False
sat1 = Sayfa2.Cells(Rows.Count, "B").End(xlUp).Row
sat2 = Sayfa4.Cells(Rows.Count, "A").End(xlUp).Row
For i = 2 To sat1
If Cells(i, "B").Value <> "" Then
Set k = Sayfa4.Range("A1:A" & sat2).Find(Cells(i, "B").Value, , xlValues, xlWhole)
If Not k Is Nothing Then
adr = k.Address
Do
If Cells(i, "D").Value = k.Offset(0, 2).Value Then
k.Offset(0, 1).Copy Sayfa2.Cells(i, "C")
k.Offset(0, 3).Copy Sayfa2.Cells(i, "E")
Application.CutCopyMode = False
Exit Do
End If
Set k = Sayfa4.Range("A1:A" & sat2).FindNext(k)
Loop While Not k Is Nothing And k.Address <> adr
End If
End If
Next i
Sayfa2.Range("C2:E" & sat1).Font.Size = 10
Application.ScreenUpdating = True
End Sub

Yardımlarınız için şimdiden teşekkür ederim
 
Geri
Üst