Soru Çoklu Veri Karşılaştırma

[husocan005]

Merhaba,

Bir Satırda Adı Soyadı ve Tc Numarası ve Bağlantı numarası mevcut.Diğer Satırda isim aynı isim ve bağlantı numarası var ancak TC numarası yok. Yapmak istediğim Adı Soyadı ve Bağlantı nesnesini karşılaştırıp var olan tc yi Olmayan Satıra getirmek. Örnek ektedir.

Şimdiden teşekkür ederim

Ornek.xlsx dosyasını indir - download

Ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s6.dosya.tc

 

[hamitcan]

Başka bir sayfa açın ve veritabanı oluşturun. isim,tc,bağlantı nesnesi vs... Buradan düşeyara formülü ile çağırmak kolay olacaktır. Verileri teke indirmek için de Veri>Yinelenleri Kaldır fonksiyonunu kullanabilirsiniz.

 

[husocan005]

Hamitcan hocam nasıl yapılacağı hakkında hiç bir bilgim yok yardımcı olur musunuz.

 

[Korhan Ayhan]

Verilerinizi yedekleyerek deneyiniz.

Option Explicit

Sub Fast_Vlookup()
    Dim My_Data As Variant, My_Array As Object, Last_Row As Long
    Dim X As Long, Record_Count As Long, Process_Time As Double
   
    Process_Time = Timer
   
    Set My_Array = VBA.CreateObject("Scripting.Dictionary")
   
    Last_Row = Cells(Rows.Count, 1).End(3).Row
    If Last_Row < 3 Then Last_Row = 3
   
    My_Data = Range("A2:H" & Last_Row).Value2
   
    ReDim My_List(1 To Rows.Count, 1 To 1)
   
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        Record_Count = Record_Count + 1
        If My_Data(X, 2) <> "" And InStr(1, My_Data(X, 2), "*") > 0 Then
            If Not My_Array.Exists(My_Data(X, 1) & "|" & My_Data(X, 8)) Then
                My_Array.Add My_Data(X, 1) & "|" & My_Data(X, 8), Record_Count
                My_List(Record_Count, 1) = My_Data(X, 2)
            End If
        End If
    Next
   
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        If My_Data(X, 2) = "" Then
            If My_Array.Exists(My_Data(X, 1) & "|" & My_Data(X, 8)) Then
                My_List(X, 1) = My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1)
            End If
        Else
            If My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1) <> My_Data(X, 2) Then
                My_List(X, 1) = My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1)
            Else
                My_List(X, 1) = My_Data(X, 2)
            End If
        End If
    Next
   
    Range("B2").Resize(Record_Count, 1) = My_List
   
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second"
End Sub

 

[hamitcan]

Ben de formülle bir şeyler yapmaya çalıştım.

 

[husocan005]

Korhan hocamın makrosu işe yaradı Teşekkür ederim. Hamitcan hocam sizede teşekkür ederim.

 

[husocan005]

Korhan hocam ben örnek yüklerken tc numaralarına yıldız koymuştum. Çalışma sayfama gerçek tc numaralarını yazınca Run time Error 9 Subscript out of range diye makro hata veriyor. Ama tcleri ********** yapınca makro işliyor. Ne yapmam gerekiyor?

 

[Korhan Ayhan]

Bu detayı foruma soru sorarken belirtmelisiniz. Sonuçta sizin paylaştığınız örnek dosyaya göre kodlama yapıyoruz.

Deneyiniz.

Option Explicit

Sub Fast_Vlookup()
    Dim My_Data As Variant, My_Array As Object, Last_Row As Long
    Dim X As Long, Record_Count As Long, Process_Time As Double
    
    Process_Time = Timer
    
    Set My_Array = VBA.CreateObject("Scripting.Dictionary")
    
    Last_Row = Cells(Rows.Count, 1).End(3).Row
    If Last_Row < 3 Then Last_Row = 3
    
    My_Data = Range("A2:H" & Last_Row).Value2
    
    ReDim My_List(1 To Rows.Count, 1 To 1)
    
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        Record_Count = Record_Count + 1
        If My_Data(X, 2) <> "" Then
            If Not My_Array.Exists(My_Data(X, 1) & "|" & My_Data(X, 8)) Then
                My_Array.Add My_Data(X, 1) & "|" & My_Data(X, 8), Record_Count
                My_List(Record_Count, 1) = My_Data(X, 2)
            End If
        End If
    Next
    
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        If My_Data(X, 2) = "" Then
            If My_Array.Exists(My_Data(X, 1) & "|" & My_Data(X, 8)) Then
                My_List(X, 1) = My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1)
            End If
        Else
            If My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1) <> My_Data(X, 2) Then
                My_List(X, 1) = My_List(My_Array.Item(My_Data(X, 1) & "|" & My_Data(X, 8)), 1)
            Else
                My_List(X, 1) = My_Data(X, 2)
            End If
        End If
    Next
    
    Range("B2").Resize(Record_Count, 1) = My_List
    
    MsgBox "Your transaction is complete." & vbCr & vbCr & _
           "Processing time ; " & Format(Timer - Process_Time, "0.00") & " Second"
End Sub

 

[husocan005]

Korhan hocam emeğine sağlık kod çok hızlı ve doğru bir şekilde çalıştı.