• DİKKAT

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

Vba Vlookup ile 2 sayfayı karşılaştırma ?

D

DullCakes

Katılım
30 Eylül 2012
Mesajlar
45
Excel Vers. ve Dili
2012
İyi günler excel dosyamdaki 2 sayfadaki verileri karşılaştırıp diğer 3. sayfaya olmayanları yazdırmak istiyorum bunun için koordinat koordinat kontrol ediyorum ve gayet düzgün çalışıyor ancak kayıt sayısı büyük olduğunda donmalar yaşıyorum bu yüzden bu yöntemden vaz geçip Vlookup ile yapmaya karar verdim ama nasıl yapılıyor bilmiyorum.

Kod: 
Dim varmı As Boolean
varmı = False

For i = 1 To Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
    For j = 1 To Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column
    varmı = False
    
        For k = 1 To Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row

            If Worksheets("Sayfa1").Cells(i, j).Value = Worksheets("Sayfa2").Cells(k, j).Value Then
                varmı = True
                Exit For
            End If
            
        Next k
       
        If varmı = False Then
           
            For k = 1 To Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column
                Worksheets("Sonuç").Cells(x, k).Value = Worksheets("Sayfa1").Cells(i, k).Value
            Next k
            
            x = x + 1
            Exit For
            
        End If
        
    Next j
Next i
 

Ekli dosyalar

Son düzenleme:
Örnek bir dosya eklerseniz daha kolay çözüm bulursunuz.
 
Yukarıdaki kodların çalıştığı dosyayı yüklerseniz daha ii olacaktır.
 
ekteki kodları test eder misiniz.

Kod: 
Sub farklı()
Dim i As Integer
Dim j As Integer
Dim dizi1(1 To 1048000)
Dim dizi2(1 To 1048000)

For i = 1 To Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
    For j = Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi1(i) = Worksheets("Sayfa1").Cells(i, j) & ";" & dizi1(i)
Next j, i

For x1 = 1 To Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row
    For x2 = Worksheets("Sayfa2").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi2(x1) = Worksheets("Sayfa2").Cells(x1, x2) & ";" & dizi2(x1)
Next x2, x1

son1 = Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
son2 = Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row

For x3 = 1 To son1
For x4 = 1 To son2
If dizi1(x3) = dizi2(x4) Then
dizi1(x3) = Empty
Exit For
End If
Next x4, x3


For x5 = 1 To son1
If dizi1(x5) <> Empty Then
aa = dizi1(x5)
dgr = 1
Sat = Sat + 1
For i = 1 To Len(aa)
    CC = Mid(aa, i, 1)
    If CC = ";" Then
    Worksheets("Sonuç").Cells(Sat, dgr) = DD
    DD = ""
    dgr = dgr + 1
    Else
    DD = DD & CC
    End If
    Next
    DD = ""
End If
Next x5
End Sub
 
Eğer "Sayfa1'de satırdaki 4 hücre ile Sayfa2'deki 4 hücre aynıysa bir şey yapma, değilse yani 4 hücresi de aynı olmayan kayıt varsa Sonuç sayfasına kopyala" diyorsanız aşağıdaki kodları dener misiniz?
Kod: 
Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sonuç")
For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIfs(s2.[a:a], s1.Cells(i, 1), s2.[b:b], s1.Cells(i, 2), s2.[c:c], s1.Cells(i, 3), s2.[d:d], s1.Cells(i, 4)) = 0 Then
s1.Range(Cells(i, "a"), Cells(i, "D")).Select
Selection.Copy
s3.Select
a = s3.Cells(Rows.Count, 1).End(3).Row + 1
Cells(a, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
s1.Select
Cells(i, 1).Select
End If
Next
End Sub
 
Son düzenleme:
YUSUF44' Alıntı:
Eğer "Sayfa1'deki satırdaki 4 hücre ile Sayfa2'deki 4 hücre aynıysa bir şey yapma, değil se yani 4 hücreside aynı olmayan kayıt varsa Sonuç sayfasına kopyala" diyorsanız sşağıdaki kodları dener misiniz?
Kod: 
Sub aktar()
Application.ScreenUpdating = False
Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Sayfa2")
Set s3 = Sheets("Sonuç")
For i = 1 To s1.Cells(Rows.Count, 1).End(3).Row
If WorksheetFunction.CountIfs(s2.[a:a], s1.Cells(i, 1), s2.[b:b], s1.Cells(i, 2), s2.[c:c], s1.Cells(i, 3), s2.[d:d], s1.Cells(i, 4)) = 0 Then
s1.Range(Cells(i, "a"), Cells(i, "D")).Select
Selection.Copy
s3.Select
a = s3.Cells(Rows.Count, 1).End(3).Row + 1
Cells(a, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
s1.Select
Cells(i, 1).Select
End If
Next
End Sub
Genişletmek için tıkla ...

Aynı donma sorununu bu kodlada yaşıyorum :(
 
Eğer dosyanız büyükse sayfa1'deki satır sayınız çoksa tabi ki tümünü kontrol edinceye kadar biraz vakit geçecektir. gönderdiğiniz örnek dosyada denediğimde düzgün bir şekilde çalıştı. Büyük dosyalarda ne kadar sürer, ne zaman cevap vermemek üzere kilitlenir bilmiyorum maalesef.
 
Solved

Huseyinkis' Alıntı:
ekteki kodları test eder misiniz.

Kod: 
Sub farklı()
Dim i As Integer
Dim j As Integer
Dim dizi1(1 To 1048000)
Dim dizi2(1 To 1048000)

For i = 1 To Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
    For j = Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi1(i) = Worksheets("Sayfa1").Cells(i, j) & ";" & dizi1(i)
Next j, i

For x1 = 1 To Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row
    For x2 = Worksheets("Sayfa2").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi2(x1) = Worksheets("Sayfa2").Cells(x1, x2) & ";" & dizi2(x1)
Next x2, x1

son1 = Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
son2 = Worksheets("Sayfa2").Range("A" & Rows.Count).End(xlUp).Row

For x3 = 1 To son1
For x4 = 1 To son2
If dizi1(x3) = dizi2(x4) Then
dizi1(x3) = Empty
Exit For
End If
Next x4, x3


For x5 = 1 To son1
If dizi1(x5) <> Empty Then
aa = dizi1(x5)
dgr = 1
Sat = Sat + 1
For i = 1 To Len(aa)
    CC = Mid(aa, i, 1)
    If CC = ";" Then
    Worksheets("Sonuç").Cells(Sat, dgr) = DD
    DD = ""
    dgr = dgr + 1
    Else
    DD = DD & CC
    End If
    Next
    DD = ""
End If
Next x5
End Sub
Genişletmek için tıkla ...

Bu sorunumu çözdü ;) birde anlatabilirseniz çok memnun olurum

anlatmanızı istediğim oluşturduğunuz dizilerin yapıları , Mid metodu ve CC , DD deyimlerinin ne işene yaradığı :)
 
Sayfa1'i 4 bin küsür satıra, sayfa2'yi bin küsür satıra çıkardığımda makronun ayrıştırması tam olarak 2 dakika 20 saniye sürdü :(
 
20k satır da 25sn civarında sürdü Huseyinkis ' in algoritmasıyla gayet başarılı ;)
 
DullCakes' Alıntı:
Bu sorunumu çözdü ;) birde anlatabilirseniz çok memnun olurum

anlatmanızı istediğim oluşturduğunuz dizilerin yapıları , Mid metodu ve CC , DD deyimlerinin ne işene yaradığı :)
Genişletmek için tıkla ...

dizi tanımlamaları sütunlar ve satırlar gibidir.

Örnek
Dizi( 1 to 100000) bu tanım tek sütunlu 100000 hücreli bir excel sayfası.

Dizi(1 to 50, 1 to 5, 1 to 40) bu tanım 3 sütunlu 50*5*40= 10000 sütunlu bir excel sayfası gibi duşunun fakat işlemleri diziler üzerinden yapmak daha hızlı sonuç almanızı sağlayacaktır.


Dim dizi1(1 To 1048000)
Dim dizi2(1 To 1048000)

Sizin dosya için 2 dizi tanımlaması yaptım. Daha sonra bu tanımlamamın içerisine sizin dosyanızda satırlarda bulunan verileri tek hücreye aralarına ";" işareti koyarak birleştirdim.

For i = 1 To Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
For j = Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi1(i) = Worksheets("Sayfa1").Cells(i, j) &";"& dizi1(i)
Next j, i


Daha sonra dizi1 içerisindeki verileri dizi2 de aratıp olanları silmesini istedim.

For x3 = 1 To son1
For x4 = 1 To son2
If dizi1(x3) = dizi2(x4) Then
dizi1(x3) = Empty
Exit For
End If
Next x4, x3


en son bolümde ise dizi1 içerisine ";" ile birleştirdiğim satırları ayırmak için CC ve DD tanımlamalarını kullandım.

Öncelikle ayırmak istediğiniz kelimeyi seçiyorsunuz.

aa = dizi1(x5)

daha sonra kelimenin uzunluğu kadar bir döngü oluşturup

For i = 1 To Len(aa)

içerisinden tek harfi çekip bunun sizin ayırmak için kullandığınız harf karakter olup olamadığına bakıyor.

CC = Mid(aa, i, 1)

If CC = ";" Then

eğer sizin ayırdığınız karakter değilse bunu DD tanımına kaydediyor.
hü;seyin; kelimemiz olsa idi DD=h olarak kayıt edicektir döngü 2 harfe geldiğinde DD=hü olarak devam edicek 3 harfe geldiğinde ";" işaretini gördüğü için DD tanımı hücreye yazıp tanımın içini temizleyecekti.

İnşallah yardımcı olur biraz karışık oldu gibi.
 
Huseyinkis' Alıntı:
dizi tanımlamaları sütunlar ve satırlar gibidir.

Örnek
Dizi( 1 to 100000) bu tanım tek sütunlu 100000 hücreli bir excel sayfası.

Dizi(1 to 50, 1 to 5, 1 to 40) bu tanım 3 sütunlu 50*5*40= 10000 sütunlu bir excel sayfası gibi duşunun fakat işlemleri diziler üzerinden yapmak daha hızlı sonuç almanızı sağlayacaktır.


Dim dizi1(1 To 1048000)
Dim dizi2(1 To 1048000)

Sizin dosya için 2 dizi tanımlaması yaptım. Daha sonra bu tanımlamamın içerisine sizin dosyanızda satırlarda bulunan verileri tek hücreye aralarına ";" işareti koyarak birleştirdim.

For i = 1 To Worksheets("Sayfa1").Range("A" & Rows.Count).End(xlUp).Row
For j = Worksheets("Sayfa1").Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
dizi1(i) = Worksheets("Sayfa1").Cells(i, j) &";"& dizi1(i)
Next j, i


Daha sonra dizi1 içerisindeki verileri dizi2 de aratıp olanları silmesini istedim.

For x3 = 1 To son1
For x4 = 1 To son2
If dizi1(x3) = dizi2(x4) Then
dizi1(x3) = Empty
Exit For
End If
Next x4, x3


en son bolümde ise dizi1 içerisine ";" ile birleştirdiğim satırları ayırmak için CC ve DD tanımlamalarını kullandım.

Öncelikle ayırmak istediğiniz kelimeyi seçiyorsunuz.

aa = dizi1(x5)

daha sonra kelimenin uzunluğu kadar bir döngü oluşturup

For i = 1 To Len(aa)

içerisinden tek harfi çekip bunun sizin ayırmak için kullandığınız harf karakter olup olamadığına bakıyor.

CC = Mid(aa, i, 1)

If CC = ";" Then

eğer sizin ayırdığınız karakter değilse bunu DD tanımına kaydediyor.
hü;seyin; kelimemiz olsa idi DD=h olarak kayıt edicektir döngü 2 harfe geldiğinde DD=hü olarak devam edicek 3 harfe geldiğinde ";" işaretini gördüğü için DD tanımı hücreye yazıp tanımın içini temizleyecekti.

İnşallah yardımcı olur biraz karışık oldu gibi.
Genişletmek için tıkla ...

Allah Razı olsun yeterince açıklayıcı oldu peki bunları düşeyara(vlookup) ile yapsak daha performanslı olmazmı ?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst