İkili karşılaştırma ile farklı kayıtları bulmak

[lwnti]

Merhaba,

Çok sütunlu bir excelde aynı satıraki 2 hücre değerini diğer sayfadaki değerlerle karşılaştırıp aynı satırda birlikte eşleşenleri temizlemek, farklı olan satırları bulmak ve 3cü bir sayfaya yazdırmak istiyorum.Ekte örnek bir dosya ekledim ve açıklama da belirttim. Forumda benzer macrolar var ama tam ihtiyacımı karşılamıyor. Önemli olan bu iki değerin diğer sayfada aynı satırda eşleşip eşleşmediğini tespit etmek. Yardımlarınız için şimdiden çok teşekkür ederim.

 

[excel03]

Merhaba;

 Sub SatırKontrol()
Dim aralık1 As Range
Dim aralık2 As Range
Dim aralık3 As Range
s1 = Worksheets(1).Cells(65536, "a").End(3).Row
s2 = Worksheets(2).Cells(65536, "a").End(3).Row
s3 = Worksheets(3).Cells(65536, "a").End(3).Row

Set aralık1 = Worksheets(1).Range("a1:f" & s1)
Set aralık2 = Worksheets(2).Range("a1:f" & s1)
Set aralık3 = Worksheets(3).Range("a1:f" & s1)
Worksheets(1).Select
For i = 1 To s1
s3 = Worksheets(3).Cells(65536, "a").End(3).Row
x = aralık1.Cells(i, 3).Value
y = aralık2.Cells(i, 3).Value
z = aralık3.Cells(i, 3).Value
x1 = aralık1.Cells(i, 6).Value
y1 = aralık2.Cells(i, 6).Value
z1 = aralık3.Cells(i, 6).Value
If Not x = y Or Not x1 = y1 Then
aralık1.Range(Cells(i, 1), Cells(i, 6)).Copy aralık3.Cells(s3 + 1, 1)
aralık1.Range(Cells(i, 1), Cells(i, 6)).Font.Color = vbRed
End If
Next
MsgBox "İşlem Tamam"
End Sub

 

[Korhan Ayhan]

Selamlar,

Forumumuza hoşgeldiniz.

Alternatif olarak yardımcı sütun ve fonksiyonlarla hazırlamış olduğum örnek dosyayı incelermisiniz.

 

[lwnti]

Selamlar,

Forumumuza hoşgeldiniz.

Alternatif olarak yardımcı sütun ve fonksiyonlarla hazırlamış olduğum örnek dosyayı incelermisiniz.

Çok teşekkür ederim. Bu tam istediğim sonuca ulaştırıyor. excel03 arkadaşın yazdığını da denedim ama biraz farklı bir çalışma olmuş. Peki bu alternatif hazırladığınız formülleri macro olarak yazdırabilir miyiz?

 

[lwnti]

Merhaba;

 Sub SatırKontrol()
Dim aralık1 As Range
Dim aralık2 As Range
Dim aralık3 As Range
s1 = Worksheets(1).Cells(65536, "a").End(3).Row
s2 = Worksheets(2).Cells(65536, "a").End(3).Row
s3 = Worksheets(3).Cells(65536, "a").End(3).Row

Set aralık1 = Worksheets(1).Range("a1:f" & s1)
Set aralık2 = Worksheets(2).Range("a1:f" & s1)
Set aralık3 = Worksheets(3).Range("a1:f" & s1)
Worksheets(1).Select
For i = 1 To s1
s3 = Worksheets(3).Cells(65536, "a").End(3).Row
x = aralık1.Cells(i, 3).Value
y = aralık2.Cells(i, 3).Value
z = aralık3.Cells(i, 3).Value
x1 = aralık1.Cells(i, 6).Value
y1 = aralık2.Cells(i, 6).Value
z1 = aralık3.Cells(i, 6).Value
If Not x = y Or Not x1 = y1 Then
aralık1.Range(Cells(i, 1), Cells(i, 6)).Copy aralık3.Cells(s3 + 1, 1)
aralık1.Range(Cells(i, 1), Cells(i, 6)).Font.Color = vbRed
End If
Next
MsgBox "İşlem Tamam"
End Sub

Merhaba,
Bu tam olarak düşündüğüm bir kod değilmiş. Örnek dosyada veri sayfasındaki son 12 satırın yazılması gerekiyor normalde. Bu kod ile veri sayfasındaki tüm kayıtlar yazılıyor nerdeyse.

 

[excel03]

Sorunuzun bir kısmını hatalı anlamamdan kaynaklanmış.

Sub SatırKontrol()
Dim aralık1 As Range
Dim aralık2 As Range
Dim aralık3 As Range
Dim Vhesap()
Dim Visyeri()
Dim Ahesap()
Dim Aisyeri()
Dim kopyala As Boolean
kopyala = False

s1 = Worksheets(1).Cells(65536, "a").End(3).Row
s2 = Worksheets(2).Cells(65536, "a").End(3).Row
s3 = Worksheets(3).Cells(65536, "a").End(3).Row

ReDim Vhesap(s1)
ReDim Visyeri(s1)
ReDim Ahesap(s2)
ReDim Aisyeri(s2)

Set aralık1 = Worksheets(1).Range("a1:f" & s1)
Set aralık2 = Worksheets(2).Range("a1:f" & s2)
Set aralık3 = Worksheets(3).Range("a1:f" & s3)
Worksheets(1).Select
For i = 1 To s1
        Vhesap(i) = aralık1.Cells(i, 3)
        Visyeri(i) = aralık1.Cells(i, 6)
                    For j = 1 To s2
                    s3 = Worksheets(3).Cells(65536, "a").End(3).Row
                    Ahesap(j) = aralık2.Cells(j, 3)
                    Aisyeri(j) = aralık2.Cells(j, 6)
                    If Vhesap(i) = Ahesap(j) And Visyeri(i) = Aisyeri(j) Then
                    kopyala = False
                    Exit For
                    Else
                    kopyala = True
                    End If
                    Next
        If kopyala = True Then
        aralık1.Range(Cells(i, 1), Cells(i, 6)).Copy aralık3.Cells(s3 + 1, 1)
        End If
Next
MsgBox "İşlem Tamam"
End Sub

 

[lwnti]

Çok teşekkür ederim. Dört dörtlük çalışıyor. Bizim işyeri, raporları diğer piyasadaki firmalardan farklı ve manual olarak exceller üzerinden yürütüyor. Rakip firmalar milyon dolarlık modüller üzerinde çalışıyor halbuki. O yüzden kendimi temelden başlayarak biraz macro kodlar konusunda geliştirmeyi düşünüyorum.

 

[lwnti]

Merhaba,

Bu dosyaya macro ile farklı bir kontrol eklemek istiyorum. Excel03 arkadaşın yazdığı son macro'daki karşılaştırma mantığı ile aynı olacak (işyeri+hesap kontrolü). sheet1'deki verilerde bulunan işyeri+hesap(örneğin c2+f2 hüce değeri), sheet2'deki arşivde kaç defa geçiyor ? Yani bir sayaç eklemek istiyorum. Bunun sonucunu sheet1'deki her satırın sonunda göstersin istiyorum. Hiç yoksa "0" olarak göstersin.

 

[lwnti]

Sorunuzun bir kısmını hatalı anlamamdan kaynaklanmış.

Sub SatırKontrol()
Dim aralık1 As Range
Dim aralık2 As Range
Dim aralık3 As Range
Dim Vhesap()
Dim Visyeri()
Dim Ahesap()
Dim Aisyeri()
Dim kopyala As Boolean
kopyala = False

s1 = Worksheets(1).Cells(65536, "a").End(3).Row
s2 = Worksheets(2).Cells(65536, "a").End(3).Row
s3 = Worksheets(3).Cells(65536, "a").End(3).Row

ReDim Vhesap(s1)
ReDim Visyeri(s1)
ReDim Ahesap(s2)
ReDim Aisyeri(s2)

Set aralık1 = Worksheets(1).Range("a1:f" & s1)
Set aralık2 = Worksheets(2).Range("a1:f" & s2)
Set aralık3 = Worksheets(3).Range("a1:f" & s3)
Worksheets(1).Select
For i = 1 To s1
        Vhesap(i) = aralık1.Cells(i, 3)
        Visyeri(i) = aralık1.Cells(i, 6)
                    For j = 1 To s2
                    s3 = Worksheets(3).Cells(65536, "a").End(3).Row
                    Ahesap(j) = aralık2.Cells(j, 3)
                    Aisyeri(j) = aralık2.Cells(j, 6)
                    If Vhesap(i) = Ahesap(j) And Visyeri(i) = Aisyeri(j) Then
                    kopyala = False
                    Exit For
                    Else
                    kopyala = True
                    End If
                    Next
        If kopyala = True Then
        aralık1.Range(Cells(i, 1), Cells(i, 6)).Copy aralık3.Cells(s3 + 1, 1)
        End If
Next
MsgBox "İşlem Tamam"
End Sub

Merhaba Excel03 Hocam,

Bu koddaki hesap=hesap and işyeri=işyeri kontrolüne göre worksheet1'deki hesap+işyeri değeri worksheet2'de kaç defa geçtiğini 1.ci sayfanın G sütununda göstermesini istiyorum. Eksik anlatmamak için örnek dosyayı ve yapmak istediğim hesaplamayı ekteki dosyada belirttim. Bu hesaplamayı yapacak bir macro kod için yardımcı olabilir misiniz?