Birden fazla veriyi tek sütunda arama

[benjanim]

Merhaba, aradım ama bulamadım.

2 farklı excel dosyam var. Birisi 250 kayıt, diğeri 230 kayıt. Her ikisi de tc kimlik numaralarını içeriyor. 230 olandaki her şey 250 olanda var. Yani geriye kalan 20 numara farklı.

Acaba 250 kayıt olanda olup da 230 da olmayan o 20 farklı satırı (tc yi ) nasıl bulabilirim? Tek tek oradan kopyala diğerinde ctrl + f ile ara yapmak çağdışı geldi birden bana (2 saatten fazla alacak ve bu prosedürü 4000 e kadar yapacağım ay boyunca)

Umarım doğru yere açtım ve meramımı anlatabildim. İlginiz için şimdiden teşekkürler.

Düzenleme

Ekte örnek a ve b dosyaları var. a dosyasında 10 tane numara var. b dosyasında a'da olan 8 numara var (diğer ikisi yok). b'da a'dan farklı bir şey yok.

Bu farklı 2 hücreyi (numarayı) nasıl bulurum bunu arıyorum. Tek tek b'dekileri a'da ctrl+f ile aratabilirim ama sayı 4000 ve her ay yapılacak bir iş olduğundan çok zaman kaybı. b'de olmayanlar bana lazım. Umarım bu sefer oldu.

 

[Murat OSMA]

Merhaba, öncelikle hoş geldiniz...

Dosyalarınızı eklerseniz, yardımcı olacak olan arkadaşlar size net bir çözüm sunabilirler...

 

[benjanim]

Merhaba, öncelikle hoş geldiniz...

Dosyalarınızı eklerseniz, yardımcı olacak olan arkadaşlar size net bir çözüm sunabilirler...

teşekkürler hoşbulduk.

Örnek dosyaları ekleyip ilk posta açıklamayı koydum.

 

[Murat OSMA]

Şu kodları bir deneyiniz...

Sub Farkli_Veriler()
    Dim con As Object, rs As Object
    Application.ScreenUpdating = False
    Workbooks.Open (ThisWorkbook.Path & "\b.xls")
    Columns(1).Copy: ThisWorkbook.Activate: Sheets(2).Select
    Columns(1).PasteSpecial xlValues: Sheets(1).Select
    Set con = CreateObject("adodb.connection")
    con.Open "provideR=microsoft.jet.oledb.4.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""
    Set rs = CreateObject("adodb.recordset")
    rs.Open "select * from [Sayfa1$] where not exists (select * from [Sayfa2$] where [Sayfa1$].[TC KİMLİK NO]=[Sayfa2$].[TC KİMLİK NO])", con, 1, 1
        If rs.RecordCount > 0 Then
            Range("B2").CopyFromRecordset rs
        End If
    Application.CutCopyMode = False
    Workbooks(2).Close: Columns.AutoFit
    Application.ScreenUpdating = True
    Set rs = Nothing: Set con = Nothing
End Sub

Dosyayı da ekliyorum...

 

[Murat OSMA]

Dosyayı deneyebildiniz mi ? :dusun: