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

Katılım
1 Aralık 2008
Mesajlar
233
Excel Vers. ve Dili
Microsoft Excel 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
23/07/2020
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




 

hamitcan

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
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.
 
Katılım
1 Aralık 2008
Mesajlar
233
Excel Vers. ve Dili
Microsoft Excel 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
23/07/2020
Hamitcan hocam nasıl yapılacağı hakkında hiç bir bilgim yok yardımcı olur musunuz.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Verilerinizi yedekleyerek deneyiniz.

C++:
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

Uzman
Uzman
Katılım
1 Temmuz 2004
Mesajlar
7,712
Excel Vers. ve Dili
Excel 2019 Türkçe
Ben de formülle bir şeyler yapmaya çalıştım.
 

Ekli dosyalar

Katılım
1 Aralık 2008
Mesajlar
233
Excel Vers. ve Dili
Microsoft Excel 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
23/07/2020
Korhan hocamın makrosu işe yaradı Teşekkür ederim. Hamitcan hocam sizede teşekkür ederim.
 
Katılım
1 Aralık 2008
Mesajlar
233
Excel Vers. ve Dili
Microsoft Excel 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
23/07/2020
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

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu detayı foruma soru sorarken belirtmelisiniz. Sonuçta sizin paylaştığınız örnek dosyaya göre kodlama yapıyoruz.

Deneyiniz.

C++:
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
 
Katılım
1 Aralık 2008
Mesajlar
233
Excel Vers. ve Dili
Microsoft Excel 2016 TR 32 Bit
Altın Üyelik Bitiş Tarihi
23/07/2020
Korhan hocam emeğine sağlık kod çok hızlı ve doğru bir şekilde çalıştı.
 
Üst