• DİKKAT

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

Makro ile veri karşılaştırma

B

bmutlu966

Katılım
26 Ocak 2006
Mesajlar
757
Excel Vers. ve Dili
Office 365 İngilizce 64 Bit
Arkadaşlar selam,

15-20 bin satırdan oluşan 3 hücredeki bilgileri diğer sayfada aratmak ve 3 kriteri sağlayan satırları işaretlemek istiyorum. Örnek dosyada açıkladım. Ben klasik for ve if ile yapmaya çalışsam da sonuç çok uzun sürecek gibi geldi. Bu konuda uzman arkadaşlardan yardım alabilirsem çok sevinirim.

Peşin teşekkürlerimle...
 

Ekli dosyalar

Merhabalar,
Altın üye olmadığımızdan dosyanızı açamamakla birlikte, 3 kritere göre şöyle deneyebilirsiniz.
İşaretleme yapacağınız sayfaya bir buton koyun ve buton altına aşağıdaki kodları (kendinize göre revize ederek) yazın.
Sub Düğme1_Tıklat()
Set Sayfa = Sheets("Arama yapacağınız sayfanın ismini yazın")
For a = 1 To [A1048576].End(xlUp).Row
For b = 1 To Sayfa.[A1048576].End(xlUp).Row
If Cells(a, 1) = Sayfa.Cells(b, 1) And Cells(a, 2) = Sayfa.Cells(b, 2) And Cells(a, 3) = Sayfa.Cells(b, 3) Then _
Rows(a).Interior.ColorIndex = 6 'Sarı renktir
Next b
Next a
Set Sayfa = Nothing
End Sub
 
Alternatif kod.

Kod: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet, a(), w(), dc As Object
Dim i As Long, krt As String, say As Long, j As Byte
    Set s1 = Sheets("SP Data")
    Set s2 = Sheets("Aranan")
    Set dc = CreateObject("scripting.dictionary")
    
        a = s1.Range("E2:O" & s1.Cells(Rows.Count, 5).End(xlUp).Row).Value
        For i = 1 To UBound(a)
            krt = CStr(a(i, 1)) & "|" & a(i, 8) & "|" & a(i, 11)
            dc(krt) = ""
        Next i

    Erase a
    
    a = s2.Range("A2:I" & s2.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim w(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = CStr(a(i, 5)) & "|" & a(i, 1) & "|" & a(i, 9)
            If dc.exists(krt) Then
                w(i, 1) = "OK"
            Else
                w(i, 1) = ""
            End If
        Next i
        
    Application.ScreenUpdating = 0
        s2.[B2].Resize(UBound(a)) = w
    Application.ScreenUpdating = 1
MsgBox "İşlem tamam.", vbInformation
End Sub
 
Saban Sertkaya' Alıntı:
Merhabalar,
Altın üye olmadığımızdan dosyanızı açamamakla birlikte, 3 kritere göre şöyle deneyebilirsiniz.
İşaretleme yapacağınız sayfaya bir buton koyun ve buton altına aşağıdaki kodları (kendinize göre revize ederek) yazın.
Sub Düğme1_Tıklat()
Set Sayfa = Sheets("Arama yapacağınız sayfanın ismini yazın")
For a = 1 To [A1048576].End(xlUp).Row
For b = 1 To Sayfa.[A1048576].End(xlUp).Row
If Cells(a, 1) = Sayfa.Cells(b, 1) And Cells(a, 2) = Sayfa.Cells(b, 2) And Cells(a, 3) = Sayfa.Cells(b, 3) Then _
Rows(a).Interior.ColorIndex = 6 'Sarı renktir
Next b
Next a
Set Sayfa = Nothing
End Sub
Genişletmek için tıkla ...

Öncelikle dosyayı bile görmeden kod gönderdiğiniz için çok teşekkürler. Kodları dosyaya uyarladım. 2000 satırı 4 dk civarında kontrol etti. 15000 satırlık bir kontrol için yarım saat çalışması gerekiyor. Daha hızlı çalışacak bir alternatif lazım gibi.
 
Ziynettin' Alıntı:
Alternatif kod.

Kod: 
Sub kod()
Dim s1 As Worksheet, s2 As Worksheet, a(), w(), dc As Object
Dim i As Long, krt As String, say As Long, j As Byte
    Set s1 = Sheets("SP Data")
    Set s2 = Sheets("Aranan")
    Set dc = CreateObject("scripting.dictionary")
  
        a = s1.Range("E2:O" & s1.Cells(Rows.Count, 5).End(xlUp).Row).Value
        For i = 1 To UBound(a)
            krt = CStr(a(i, 1)) & "|" & a(i, 8) & "|" & a(i, 11)
            dc(krt) = ""
        Next i

    Erase a
  
    a = s2.Range("A2:I" & s2.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim w(1 To UBound(a), 1 To 1)
        For i = 1 To UBound(a)
            krt = CStr(a(i, 5)) & "|" & a(i, 1) & "|" & a(i, 9)
            If dc.exists(krt) Then
                w(i, 1) = "OK"
            Else
                w(i, 1) = ""
            End If
        Next i
      
    Application.ScreenUpdating = 0
        s2.[B2].Resize(UBound(a)) = w
    Application.ScreenUpdating = 1
MsgBox "İşlem tamam.", vbInformation
End Sub
Genişletmek için tıkla ...

@Ziynettin Müthiş... Emeğinize sağlık çok teşekkürler. Kodları anlamaya çalışacağım.
11000 satırı 15000 satırlık bir datada kontrol etmesi bile 1 sn sürüyor. sanırım liste kullandınız. Eğer vaktinizi almayacaksa uygun bir zamanınızda kod bloklarının arasına basit açıklama yazabilirseniz çok sevinirim.
 
Son düzenleme:
evet lütfen


@Ziynettin Müthiş... Emeğinize sağlık çok teşekkürler. Kodları anlamaya çalışacağım.
11000 satırı 15000 satırlık bir datada kontrol etmesi bile 1 sn sürüyor. sanırım liste kullandınız. Eğer vaktinizi almayacaksa uygun bir zamanınızda kod bloklarının arasına basit açıklama yazabilirseniz çok sevinirim.
Genişletmek için tıkla ...
 
Merhabalar,

Sorunuz çözümlenmiş ama merakıma muciben dosyanızı görmek istemiştim. Ekteki şekilde bir kontrol eder misiniz. Hata vs. var mı ?
(1 sn. de çözmüyor ama iş görür sanırım) :D

Kod: 
Sub Düğme1_Tıklat()
Application.ScreenUpdating = False
b = Timer
On Error Resume Next
For a = 2 To Sheets(2).[A1048576].End(xlUp).Row
Columns(12).Find(Sheets(2).Cells(a, 1)).Activate
If ActiveCell = Sheets(2).Cells(a, 1) And _
   ActiveCell.Offset(0, -7) = Sheets(2).Cells(a, 5) And _
   ActiveCell.Offset(0, 3) = Sheets(2).Cells(a, 9) Then _
Sheets(2).Cells(a, 2) = "OK"
Next a
c = Timer - b
MsgBox "İşlem Süresi : " & Int(c) & " saniye"
Application.ScreenUpdating = True
End Sub
 
Örnek dosyayı görmüş olmanız lazım. Bir önceki mesajımda var. Bu kodlar hatalı sonuç veriyor. Yani hepsine Ok yazıyor. Tekrar bir bakın isterseniz.
 
Alternatif,

Hız olarak biraz daha avantaj sağlayabilir. Kod satır aralarına kısa notlar yazdım. Kodu yorumlamanız biraz daha kolaylaşacaktır.

C++: 
Option Explicit

Sub Listeleri_Karsilastir()
    Rem Tanımlamaları yapıyoruz.
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
    Dim Veri As Variant, X As Long, Dizi As Object, Zaman As Double
    
    Rem İşlem süresini tespit etmek için zamanlayıcıyı başlatıyoruz.
    Zaman = Timer
    
    Rem İşlemde kullanacağımız nesneleri kısa isimlerle hafızaya alıyoruz.
    Set S1 = Sheets("Aranan")
    Set S2 = Sheets("SP Data")
    Set Dizi = CreateObject("Scripting.Dictionary")
    
    Rem SP Data isimli sayfadaki son satırı tespit ediyoruz.
    Son = S2.Cells(S2.Rows.Count, "L").End(3).Row
    If Son = 2 Then Son = 3
    
    Rem SP Data isimli sayfadaki tabloyu hafızaya yüklüyoruz.
    Veri = S2.Range("A2:O" & Son).Value
    
    Rem SP Data isimli sayfadaki tabloyu döngüye alıyoruz ve 3 kritere göre tekrarsız listeyi DİZİ nesnesine yüklüyoruz.
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 12) & "|" & Veri(X, 5) & "|" & Veri(X, 15)) = 1
    Next
    
    Rem Aranan sayfasındaki son satırı tespit ediyoruz.
    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
    If Son = 2 Then Son = 3
    
    Rem Aranan isimli sayfadaki tabloyu hafızaya yüklüyoruz.
    Veri = S1.Range("A2:I" & Son).Value
    
    Rem Koşula göre oluşacak OK listesi için LİSTE adında bir dizi tanımlıyoruz.
    ReDim Liste(1 To Son, 1 To 1)
    
    Rem Aranan isimli sayfadaki tabloyu döngüye alıyoruz ve 3 krtere göre eşleşen verilere OK yazdırıyoruz. Eşleşmeyen kayıtlar boş bırakılıyor.
    For X = LBound(Veri) To UBound(Veri)
        Say = Say + 1
        If Dizi.Exists(Veri(X, 1) & "|" & Veri(X, 5) & "|" & Veri(X, 9)) Then
            Liste(Say, 1) = "OK"
        Else
            Liste(Say, 1) = ""
        End If
    Next
    
    Rem Oluşan OK listesini B sütununa aktarıyoruz.
    S1.Range("B2").Resize(Say) = Liste
    
    Rem İşlemde kullanacağımız ve hafızaya aldığımız nesneleri hafızadan siliyoruz.
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
    
    Rem İşlemin tamamlandığına dair kullanıcıyı bilgilendiriyoruz.
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Korhan Ayhan' Alıntı:
Alternatif,

Hız olarak biraz daha avantaj sağlayabilir. Kod satır aralarına kısa notlar yazdım. Kodu yorumlamanız biraz daha kolaylaşacaktır.

C++: 
Option Explicit

Sub Listeleri_Karsilastir()
    Rem Tanımlamaları yapıyoruz.
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
    Dim Veri As Variant, X As Long, Dizi As Object, Zaman As Double
   
    Rem İşlem süresini tespit etmek için zamanlayıcıyı başlatıyoruz.
    Zaman = Timer
   
    Rem İşlemde kullanacağımız nesneleri kısa isimlerle hafızaya alıyoruz.
    Set S1 = Sheets("Aranan")
    Set S2 = Sheets("SP Data")
    Set Dizi = CreateObject("Scripting.Dictionary")
   
    Rem SP Data isimli sayfadaki son satırı tespit ediyoruz.
    Son = S2.Cells(S2.Rows.Count, "L").End(3).Row
    If Son = 2 Then Son = 3
   
    Rem SP Data isimli sayfadaki tabloyu hafızaya yüklüyoruz.
    Veri = S2.Range("A2:O" & Son).Value
   
    Rem SP Data isimli sayfadaki tabloyu döngüye alıyoruz ve 3 kritere göre tekrarsız listeyi DİZİ nesnesine yüklüyoruz.
    For X = LBound(Veri) To UBound(Veri)
        Dizi.Item(Veri(X, 12) & "|" & Veri(X, 5) & "|" & Veri(X, 15)) = 1
    Next
   
    Rem Aranan sayfasındaki son satırı tespit ediyoruz.
    Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
    If Son = 2 Then Son = 3
   
    Rem Aranan isimli sayfadaki tabloyu hafızaya yüklüyoruz.
    Veri = S1.Range("A2:I" & Son).Value
   
    Rem Koşula göre oluşacak OK listesi için LİSTE adında bir dizi tanımlıyoruz.
    ReDim Liste(1 To Son, 1 To 1)
   
    Rem Aranan isimli sayfadaki tabloyu döngüye alıyoruz ve 3 krtere göre eşleşen verilere OK yazdırıyoruz. Eşleşmeyen kayıtlar boş bırakılıyor.
    For X = LBound(Veri) To UBound(Veri)
        Say = Say + 1
        If Dizi.Exists(Veri(X, 1) & "|" & Veri(X, 5) & "|" & Veri(X, 9)) Then
            Liste(Say, 1) = "OK"
        Else
            Liste(Say, 1) = ""
        End If
    Next
   
    Rem Oluşan OK listesini B sütununa aktarıyoruz.
    S1.Range("B2").Resize(Say) = Liste
   
    Rem İşlemde kullanacağımız ve hafızaya aldığımız nesneleri hafızadan siliyoruz.
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
   
    Rem İşlemin tamamlandığına dair kullanıcıyı bilgilendiriyoruz.
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
Genişletmek için tıkla ...
Sayın @Korhan Ayhan kodlar ve açıklamalar için çok teşekkürler. Listelerin nasıl kullanılacağı ile ilgili güzel bir örnek oldu. Sayın @Ziynettin 'in kodlarıyla hemen hemen aynı zamanda yapıyor işlemi. Tabi jet hızında. 0.15 sn gibi bir zamanda 15000 satırı kontrol ediyor.
 
ado ile yapılmak istenilse nasıl yapılırdı ?
 
Listeden ziyade Dictionary ve Array kullanımının avantajını kullandık. Makroda kullanılan LİSTE ifadesi Array olarak bilinen dizi yöntemidir.

VBA tarafında her iki kullanımda yerine göre oldukça hızlı sonuçlar verir.
 
Ziynettin' Alıntı:
Option Explicit Sub Listeleri_Karsilastir() Rem Tanımlamaları yapıyoruz. Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long Dim Veri As Variant, X As Long, Dizi As Object, Zaman As Double Rem İşlem süresini tespit etmek için zamanlayıcıyı başlatıyoruz. Zaman = Timer Rem İşlemde kullanacağımız nesneleri kısa isimlerle hafızaya alıyoruz. Set S1 = Sheets("Aranan") Set S2 = Sheets("SP Data") Set Dizi = CreateObject("Scripting.Dictionary") Rem SP Data isimli sayfadaki son satırı tespit ediyoruz. Son = S2.Cells(S2.Rows.Count, "L").End(3).Row If Son = 2 Then Son = 3 Rem SP Data isimli sayfadaki tabloyu hafızaya yüklüyoruz. Veri = S2.Range("A2:O" & Son).Value Rem SP Data isimli sayfadaki tabloyu döngüye alıyoruz ve 3 kritere göre tekrarsız listeyi DİZİ nesnesine yüklüyoruz. For X = LBound(Veri) To UBound(Veri) Dizi.Item(Veri(X, 12) & "|" & Veri(X, 5) & "|" & Veri(X, 15)) = 1 Next Rem Aranan sayfasındaki son satırı tespit ediyoruz. Son = S1.Cells(S1.Rows.Count, "A").End(3).Row If Son = 2 Then Son = 3 Rem Aranan isimli sayfadaki tabloyu hafızaya yüklüyoruz. Veri = S1.Range("A2:I" & Son).Value Rem Koşula göre oluşacak OK listesi için LİSTE adında bir dizi tanımlıyoruz. ReDim Liste(1 To Son, 1 To 1) Rem Aranan isimli sayfadaki tabloyu döngüye alıyoruz ve 3 krtere göre eşleşen verilere OK yazdırıyoruz. Eşleşmeyen kayıtlar boş bırakılıyor. For X = LBound(Veri) To UBound(Veri) Say = Say + 1 If Dizi.Exists(Veri(X, 1) & "|" & Veri(X, 5) & "|" & Veri(X, 9)) Then Liste(Say, 1) = "OK" Else Liste(Say, 1) = "" End If Next Rem Oluşan OK listesini B sütununa aktarıyoruz. S1.Range("B2").Resize(Say) = Liste Rem İşlemde kullanacağımız ve hafızaya aldığımız nesneleri hafızadan siliyoruz. Set S1 = Nothing Set S2 = Nothing Set Dizi = Nothing Rem İşlemin tamamlandığına dair kullanıcıyı bilgilendiriyoruz. MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _ "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation End Sub
Genişletmek için tıkla ...
korhan bey sizin bu kodu ufak tefek revize ile kendime uyarladım. ancak veriler aynı sırada olması gerekiyor sizin kodda. örnek benim 1. sayfada 1000 adet verim 2. sayfada 1400 adet veri var. benzerleri buluyor ona karşılık gelen veriyi yazarken 1. sayfadaki satır sayısını baz alıyor. 1. sayfada ismail özkan 16. satırda iken 2. sayfada 27. satırda ise veriyi nasıl düzenlemek gerekir.
Option Explicit

Sub Listeleri_Karsilastir()
Rem Tanımlamaları yapıyoruz.
Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
Dim Veri As Variant, X As Long, Dizi As Object, Zaman As Double
Dim Veri2 As Variant
Rem İşlem süresini tespit etmek için zamanlayıcıyı başlatıyoruz.
Zaman = Timer

Rem İşlemde kullanacağımız nesneleri kısa isimlerle hafızaya alıyoruz.
Set S1 = Sheets("EOKUL")
Set S2 = Sheets("KÜTÜPHANE")
Set Dizi = CreateObject("Scripting.Dictionary")

Rem SP Data isimli sayfadaki son satırı tespit ediyoruz.
Son = S2.Cells(S2.Rows.Count, "A").End(3).Row
If Son = 2 Then Son = 3

Rem SP Data isimli sayfadaki tabloyu hafızaya yüklüyoruz.
Veri = S2.Range("A2:Z" & Son).Value
Veri2 = S2.Range("A2:Z" & Son).Value 'DİĞER SAYFADA ARANAN VERİNİN İSTENEN SÜTUNU GELİR
Rem SP Data isimli sayfadaki tabloyu döngüye alıyoruz ve 3 kritere göre tekrarsız listeyi DİZİ nesnesine yüklüyoruz.
For X = LBound(Veri) To UBound(Veri)
Dizi.Item(Veri(X, 1)) = 1
Next

Rem Aranan sayfasındaki son satırı tespit ediyoruz.
Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
If Son = 2 Then Son = 3

Rem Aranan isimli sayfadaki tabloyu hafızaya yüklüyoruz.
Veri = S1.Range("A2:Z" & Son).Value

Rem Koşula göre oluşacak OK listesi için LİSTE adında bir dizi tanımlıyoruz.
ReDim Liste(1 To Son, 1 To 1)

Rem Aranan isimli sayfadaki tabloyu döngüye alıyoruz ve 3 krtere göre eşleşen verilere OK yazdırıyoruz. Eşleşmeyen kayıtlar boş bırakılıyor.
For X = LBound(Veri) To UBound(Veri)
Say = Say + 1
If Dizi.Exists(Veri(X, 1)) Then
Liste(Say, 1) = Veri2(X, 2) '"OK"
Else
Liste(Say, 1) = ""
End If
Next

Rem Oluşan OK listesini B sütununa aktarıyoruz.
S1.Range("E2").Resize(Say) = Liste

Rem İşlemde kullanacağımız ve hafızaya aldığımız nesneleri hafızadan siliyoruz.
Set S1 = Nothing
Set S2 = Nothing
Set Dizi = Nothing

Rem İşlemin tamamlandığına dair kullanıcıyı bilgilendiriyoruz.
End Sub
 
SORUN ÇÖZÜLDÜ
ismailozkan4224' Alıntı:
korhan bey sizin bu kodu ufak tefek revize ile kendime uyarladım. ancak veriler aynı sırada olması gerekiyor sizin kodda. örnek benim 1. sayfada 1000 adet verim 2. sayfada 1400 adet veri var. benzerleri buluyor ona karşılık gelen veriyi yazarken 1. sayfadaki satır sayısını baz alıyor. 1. sayfada ismail özkan 16. satırda iken 2. sayfada 27. satırda ise veriyi nasıl düzenlemek gerekir.
Option Explicit

Sub Listeleri_Karsilastir()
Rem Tanımlamaları yapıyoruz.
Dim S1 As Worksheet, S2 As Worksheet, Son As Long, Say As Long
Dim Veri As Variant, X As Long, Dizi As Object, Zaman As Double
Dim Veri2 As Variant
Rem İşlem süresini tespit etmek için zamanlayıcıyı başlatıyoruz.
Zaman = Timer

Rem İşlemde kullanacağımız nesneleri kısa isimlerle hafızaya alıyoruz.
Set S1 = Sheets("EOKUL")
Set S2 = Sheets("KÜTÜPHANE")
Set Dizi = CreateObject("Scripting.Dictionary")

Rem SP Data isimli sayfadaki son satırı tespit ediyoruz.
Son = S2.Cells(S2.Rows.Count, "A").End(3).Row
If Son = 2 Then Son = 3

Rem SP Data isimli sayfadaki tabloyu hafızaya yüklüyoruz.
Veri = S2.Range("A2:Z" & Son).Value
Veri2 = S2.Range("A2:Z" & Son).Value 'DİĞER SAYFADA ARANAN VERİNİN İSTENEN SÜTUNU GELİR
Rem SP Data isimli sayfadaki tabloyu döngüye alıyoruz ve 3 kritere göre tekrarsız listeyi DİZİ nesnesine yüklüyoruz.
For X = LBound(Veri) To UBound(Veri)
Dizi.Item(Veri(X, 1)) = 1
Next

Rem Aranan sayfasındaki son satırı tespit ediyoruz.
Son = S1.Cells(S1.Rows.Count, "A").End(3).Row
If Son = 2 Then Son = 3

Rem Aranan isimli sayfadaki tabloyu hafızaya yüklüyoruz.
Veri = S1.Range("A2:Z" & Son).Value

Rem Koşula göre oluşacak OK listesi için LİSTE adında bir dizi tanımlıyoruz.
ReDim Liste(1 To Son, 1 To 1)

Rem Aranan isimli sayfadaki tabloyu döngüye alıyoruz ve 3 krtere göre eşleşen verilere OK yazdırıyoruz. Eşleşmeyen kayıtlar boş bırakılıyor.
For X = LBound(Veri) To UBound(Veri)
Say = Say + 1
If Dizi.Exists(Veri(X, 1)) Then
Liste(Say, 1) = Veri2(X, 2) '"OK"
Else
Liste(Say, 1) = ""
End If
Next

Rem Oluşan OK listesini B sütununa aktarıyoruz.
S1.Range("E2").Resize(Say) = Liste

Rem İşlemde kullanacağımız ve hafızaya aldığımız nesneleri hafızadan siliyoruz.
Set S1 = Nothing
Set S2 = Nothing
Set Dizi = Nothing

Rem İşlemin tamamlandığına dair kullanıcıyı bilgilendiriyoruz.
End Sub
Genişletmek için tıkla ...
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst