• DİKKAT

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

iki farklı sütundaki verileri karşılaştırma

S

sauner13

Katılım
28 Aralık 2016
Mesajlar
3
Excel Vers. ve Dili
İngilizce 2010
Selamlar,
aşağıda linkini verdiğim dosyada A ve B sütunlarını karşılaştırıp aynı olanları C sütununa yazdırmak istiyorum. Burada yazılan , önerilen yolları denedim fakat bir sonuç alamadım.
Yardım edebilirseniz sevinirim.
İyi günler

Dosya linki:
http://s2.dosya.tc/server4/6ppvps/hip.xlsx.html
 
sauner13' Alıntı:
Selamlar,
aşağıda linkini verdiğim dosyada A ve B sütunlarını karşılaştırıp aynı olanları C sütununa yazdırmak istiyorum. Burada yazılan , önerilen yolları denedim fakat bir sonuç alamadım.
Yardım edebilirseniz sevinirim.
İyi günler

Dosya linki:
http://s2.dosya.tc/server4/6ppvps/hip.xlsx.html
Genişletmek için tıkla ...

Ekli dosyayı inceleyiniz.

B kolonları her defasında yeniden oluşturulur.
Karşılaştırma hem HIP den HIP1 , hemde HIP1 den HIP e şekilinde yapılır.
NA lar bulunamayanlardır.

http://dosya.co/fsmls2u2j1kw/HIP_Karsilastir.xlsm.html

Kod: 
Sub FastestVlookup()
    Sheets("Sayfa2").Select
    sayfa2sonsatir = Cells(Rows.Count, "A").End(3).Row

    Sheets("Sayfa1").Select
    sayfa1sonsatir = Cells(Rows.Count, "A").End(3).Row
    secim = "B2:B" & sayfa1sonsatir
    secim1 = "B2:B" & sayfa1sonsatir
    Range(secim1).Select
    Selection.ClearContents
    Range("B2").Select
    
    formul = "=IF(VLOOKUP(RC1,Sayfa2!R1C1:R" & sayfa2sonsatir & "C1,1)=RC1,RC1,""N/A"")"
    
    With Sayfa1.Range(secim)
        .FormulaR1C1 = formul
        '.Value = .Value
    End With
   
    Sheets("Sayfa2").Select
    sayfa2sonsatir = Cells(Rows.Count, "A").End(3).Row
    secim = "B2:B" & sayfa2sonsatir
    secim1 = "B2:B" & sayfa2sonsatir
    Range(secim1).Select
    Selection.ClearContents
    Range("B2").Select
    
   formul = "=IF(VLOOKUP(RC1,Sayfa1!R1C1:R" & sayfa1sonsatir & "C1,1)=RC1,RC1,""N/A"")"
    
    With Sayfa2.Range(secim)
        .FormulaR1C1 = formul
        .Value = .Value
    End With
   
   
   MsgBox ("İşlem tamamlandı")
End Sub
 
asri' Alıntı:
Ekli dosyayı inceleyiniz.

B kolonları her defasında yeniden oluşturulur.
Karşılaştırma hem HIP den HIP1 , hemde HIP1 den HIP e şekilinde yapılır.
NA lar bulunamayanlardır.

http://dosya.co/fsmls2u2j1kw/HIP_Karsilastir.xlsm.html

Kod: 
Sub FastestVlookup()
    Sheets("Sayfa2").Select
    sayfa2sonsatir = Cells(Rows.Count, "A").End(3).Row

    Sheets("Sayfa1").Select
    sayfa1sonsatir = Cells(Rows.Count, "A").End(3).Row
    secim = "B2:B" & sayfa1sonsatir
    secim1 = "B2:B" & sayfa1sonsatir
    Range(secim1).Select
    Selection.ClearContents
    Range("B2").Select
    
    formul = "=IF(VLOOKUP(RC1,Sayfa2!R1C1:R" & sayfa2sonsatir & "C1,1)=RC1,RC1,""N/A"")"
    
    With Sayfa1.Range(secim)
        .FormulaR1C1 = formul
        '.Value = .Value
    End With
   
    Sheets("Sayfa2").Select
    sayfa2sonsatir = Cells(Rows.Count, "A").End(3).Row
    secim = "B2:B" & sayfa2sonsatir
    secim1 = "B2:B" & sayfa2sonsatir
    Range(secim1).Select
    Selection.ClearContents
    Range("B2").Select
    
   formul = "=IF(VLOOKUP(RC1,Sayfa1!R1C1:R" & sayfa1sonsatir & "C1,1)=RC1,RC1,""N/A"")"
    
    With Sayfa2.Range(secim)
        .FormulaR1C1 = formul
        .Value = .Value
    End With
   
   
   MsgBox ("İşlem tamamlandı")
End Sub
Genişletmek için tıkla ...
çok teşekkür ederim. Ellerinize sağlık
Sormak istediğim şey bu eşleşenleri ayrı kolonda yazdırabilir miyim sıralı olarak ? Çünkü eşleşenler ile farklı bir kolonu daha karşılaştıracağım
 
sakman26' Alıntı:
selam,
konuya böyle ortadan müdahil olmak istemem.
Saygısızlık olarak algılanmazsa (aksi halde mesajımı hemen silebilirim...)
ekte iki sütundaki listelerin karşılaştırılmasına yönelik Scripting.Dictionnary kullanılarak hazırladığım bir dokumanı (Genel amaçlı) bulabilirsiniz...

link : http://s2.dosya.tc/server4/jihz9x/ListeKarsilastirmaScrDic.rar.html
Genişletmek için tıkla ...

Estğ. benim açımdan bir sakıncası yok, aksine alternetif çözümler her zaman iyidir.
 
sakman26' Alıntı:
selam,
konuya böyle ortadan müdahil olmak istemem.
Saygısızlık olarak algılanmazsa (aksi halde mesajımı hemen silebilirim...)
ekte iki sütundaki listelerin karşılaştırılmasına yönelik Scripting.Dictionnary kullanılarak hazırladığım bir dokumanı (Genel amaçlı) bulabilirsiniz...

link : http://s2.dosya.tc/server4/jihz9x/ListeKarsilastirmaScrDic.rar.html
Genişletmek için tıkla ...

Teşekkür ediyorum yardımınız için . Ekteki dosyayı indirdim fakat type mismatch hatası alıyorum

Kod: 
Sub Kesisim()
  a = Range("A3:A" & [A1000000].End(xlUp).Row)
  Set d_1 = CreateObject("Scripting.Dictionary")
    For Each c In a
      d_1(c) = ""
    Next c
  b = Range("D3:D" & [D1000000].End(xlUp).Row)
  Set d_2 = CreateObject("Scripting.Dictionary")
    For Each c In b
      If d_1.exists(c) Then If Not d_2.exists(c) Then d_2(c) = ""
    Next c
  [j19] = d_2.Count
  [o3].Resize(d_2.Count, 1) = Application.Transpose(d_2.keys)
  Range("O3:O" & [O1000000].End(xlUp).Row).Sort key1:=Range("o3"), order1:=xlAscending
End Sub

Sub Birlesim()
  Set d = CreateObject("Scripting.Dictionary")
  a = Range("A3:A" & [A1000000].End(xlUp).Row)
  b = Range("D3:D" & [D1000000].End(xlUp).Row)
    For Each c In a
      d(c) = ""
    Next c
        For Each c In b
          d(c) = ""
        Next c
  [j18] = d.Count
  [m3].Resize(d.Count, 1) = Application.Transpose(d.keys)
  Range("m3:m" & [m1000000].End(xlUp).Row).Sort key1:=Range("m3"), order1:=xlAscending
End Sub

Sub Liste1_Liste2()
  a = Range("A3:A" & [A1000000].End(xlUp).Row)
  Set d_1 = CreateObject("Scripting.Dictionary")
    For Each c In a
      d_1(c) = ""
    Next c
  b = Range("D3:D" & [D1000000].End(xlUp).Row)
  Set d_2 = CreateObject("Scripting.Dictionary")
    For Each c In b
      If Not d_1.exists(c) Then d_2(c) = ""
    Next c
  [j20] = d_2.Count
  [q3].Resize(d_2.Count, 1) = Application.Transpose(d_2.keys)
  Range("q3:q" & [q1000000].End(xlUp).Row).Sort key1:=Range("q3"), order1:=xlAscending
End Sub

Sub Liste2_Liste1()
  a = Range("D3:D" & [D1000000].End(xlUp).Row)
  Set d_1 = CreateObject("Scripting.Dictionary")
    For Each c In a
      d_1(c) = ""
    Next c
  b = Range("A3:A" & [A1000000].End(xlUp).Row)
  Set d_2 = CreateObject("Scripting.Dictionary")
    For Each c In b
      If Not d_1.exists(c) Then d_2(c) = ""
    Next c
  [j21] = d_2.Count
  [s3].Resize(d_2.Count, 1) = Application.Transpose(d_2.keys)
  Range("s3:s" & [s1000000].End(xlUp).Row).Sort key1:=Range("s3"), order1:=xlAscending
End Sub

Sub sil()
Range("m3:s1000000").ClearContents
Range("m2").Select
End Sub

Sub liste()
t = Timer
    sil
    Birlesim
    Kesisim
    Liste1_Liste2
    Liste2_Liste1
MsgBox "İşlem TAMAM" & Chr(10) & "Süre : " & Format(Timer - t, "0.0000") & "  saniye"
Range("m2").Select
End Sub

burada "[m3].Resize(d.Count, 1) = Application.Transpose(d.keys)" da hata alıyorum
 
selam,
gönderdiğim dokumana sizin verileri kopyaladığımda aynı hatayı alıyorum.
Uğraştım ama kafa durdu herhalde.
 
sakman26' Alıntı:
selam,
gönderdiğim dokumana sizin verileri kopyaladığımda aynı hatayı alıyorum.
Uğraştım ama kafa durdu herhalde.
Genişletmek için tıkla ...

İşlem gören toplam hücre sayısı ile ilgili bir durum.

Liste 1 i 15000 , liste 2 yi 40000 yapın, sorunsuz çalışıyor.
 
selam,

exel de tuttuğum hesaplarda cari kaydını yaptığım zaman dökümde son kaydı araya atıyor çözüm bulamadım lürfen acil yardım dün böyle bir sorun yoktu neyi yanlış yapıyorum çok inceledim bulamadım
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst