İki Listeyi Belirli kriterlere göre karşılaştırma

numan şamil · 18 Nisan 2015

tigiy' Alıntı:
Hocam öncelikle örnek için sağolun ama sizinkide hatalı ve sadece 1. sayfaya sonuçları yazıyor. Ben dalgalikur hocamın yaptığı şekilde doğru sonuçları arıyorum.

Daha iyi anlatabilmek için çok basit bir örnek ekte mevcut.

Açıklamam gerekirse burda 1. sayfade sonuç bölümünde 2. satır için "Tarih ve Tutar tutuyor Fatura numarası Farklı" ancak "Y" yazmalıydı
yani ilk bulduğu belirlenen şartları değil aşağılarda varsa "Y" aramalı yoksa "Tarih ve Tutar tutuyor Fatura numarası Farklı" yazmalı

Sayfa 2 de ise doğru sonuç veriyor ama aynı mantığı orada da kurmalı

Merhaba Umarım olmuştur
Ekli dosyayı inceler misiniz
Not: Her iki sayfanın verileri eşit olamalı veya

Kod:

For i = 2 To[COLOR="Red"] S1.[/COLOR]Cells(Rows.Count, "A").End
(xlUp).Row

kodun kırmızı kısma hangisi çoksa ona göre ayarlanmalı

tigiy · 18 Nisan 2015

numan şamil' Alıntı:
Merhaba Umarım olmuştur
Ekli dosyayı inceler misiniz
Not: Her iki sayfanın verileri eşit olamalı veya

Kod:

For i = 2 To[COLOR="Red"] S1.[/COLOR]Cells(Rows.Count, "A").End (xlUp).Row

kodun kırmızı kısma hangisi çoksa ona göre ayarlanmalı

Hocam çok sağolun örnekte sorun yok gibi ama 10 dk önce 2000 satırlık liste çalıştırdım bekliyorum şuan asıl orada belli olacak.

numan şamil · 18 Nisan 2015

tigiy' Alıntı:
Hocam çok sağolun örnekte sorun yok gibi ama 10 dk önce 2000 satırlık liste çalıştırdım bekliyorum şuan asıl orada belli olacak.

Merhaba
41.Mesajdaki dosyayı yeniledim belki biraz daha hızlı çalışır
Tekrar bakabilir misiniz
Sonuçtan haberdar ederseniz sevinirim
İyi çalışmalar

tigiy · 18 Nisan 2015

Hocam ilk dosya için 1 buçuk saatten fazla bekledim sonuç çıkmadı.

2. dosya için sayısı 250ye düşürdüm 10 dkdır hala bir sonuç yok

halit3 · 18 Nisan 2015

Alternatif kod
kodun sağlıklı sonuç vermesi için koşullu biçimlendirmeleri kaldırın

Kod:

Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("MÜŞTERİ").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("TEST").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("MÜŞTERİ").Columns("D:D").ClearContents
Sheets("TEST").Columns("D:D").ClearContents

son2 = Sheets("MÜŞTERİ").Cells(Rows.Count, "a").End(3).Row
son1 = Sheets("TEST").Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1): ReDim ara4(son1): ReDim ara5(son1)

ReDim bul1(son1): ReDim bul2(son1): ReDim bul3(son1): ReDim bul4(son1): ReDim bul5(son1)


sat1 = 2
For j = 2 To son1
ara1(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")

If ara1(j) = "" Then
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 48
Sheets("TEST").Cells(j, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
ara2(j) = Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")
ara3(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "c")
ara4(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")
ara5(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b")

'WorksheetFunction.Trim (Cells(j, "a")) & WorksheetFunction.Trim(Cells(j, "c"))
Next j


For m = 2 To son2

If Sheets("MÜŞTERİ").Cells(m, "c") < 0 Then
deg1 = Math.Abs(Sheets("MÜŞTERİ").Cells(m, "c"))
Else
deg1 = Sheets("MÜŞTERİ").Cells(m, "c")
End If


bul1(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b") & deg1
If bul1(m) = "" Then
Sheets("MÜŞTERİ").Cells(m, "d").Interior.ColorIndex = 48
Sheets("MÜŞTERİ").Cells(m, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
bul2(m) = Sheets("MÜŞTERİ").Cells(m, "b") & deg1
bul3(m) = Sheets("MÜŞTERİ").Cells(m, "a") & deg1
bul4(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b") & deg1
bul5(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b")

Next m


For r = 2 To son1
For i = 2 To son2

If bul2(i) = ara2(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 33
Sheets("TEST").Cells(r, "d") = "Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 33
Sheets("MÜŞTERİ").Cells(i, "d") = "Fatura numarası ve tutarı birebir tutanlar"

End If


If bul3(i) = ara3(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 53
Sheets("TEST").Cells(r, "d") = "Tarih  ve tutarı hiç tutmayanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 53
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih  ve tutarı hiç tutmayanlar"

If bul4(i) <> ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 46
Sheets("TEST").Cells(r, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 46
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
End If
End If


If bul5(i) = ara5(r) Then
If bul4(i) <> ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 54
Sheets("TEST").Cells(r, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 54
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
End If
End If

If bul4(i) = ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 43
Sheets("TEST").Cells(r, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 43
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
End If
Next i

Next r


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla)

End Sub

tigiy · 18 Nisan 2015

halit3' Alıntı:

Alternatif kod
kodun sağlıklı sonuç vermesi için koşullu biçimlendirmeleri kaldırın

Kod:

Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("MÜŞTERİ").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("TEST").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("MÜŞTERİ").Columns("D:D").ClearContents
Sheets("TEST").Columns("D:D").ClearContents

son2 = Sheets("MÜŞTERİ").Cells(Rows.Count, "a").End(3).Row
son1 = Sheets("TEST").Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1): ReDim ara4(son1): ReDim ara5(son1)

ReDim bul1(son1): ReDim bul2(son1): ReDim bul3(son1): ReDim bul4(son1): ReDim bul5(son1)


sat1 = 2
For j = 2 To son1
ara1(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")

If ara1(j) = "" Then
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 48
Sheets("TEST").Cells(j, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
ara2(j) = Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")
ara3(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "c")
ara4(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b") & Sheets("TEST").Cells(j, "c")
ara5(j) = Sheets("TEST").Cells(j, "a") & Sheets("TEST").Cells(j, "b")

'WorksheetFunction.Trim (Cells(j, "a")) & WorksheetFunction.Trim(Cells(j, "c"))
Next j


For m = 2 To son2

If Sheets("MÜŞTERİ").Cells(m, "c") < 0 Then
deg1 = Math.Abs(Sheets("MÜŞTERİ").Cells(m, "c"))
Else
deg1 = Sheets("MÜŞTERİ").Cells(m, "c")
End If


bul1(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b") & deg1
If bul1(m) = "" Then
Sheets("MÜŞTERİ").Cells(m, "d").Interior.ColorIndex = 48
Sheets("MÜŞTERİ").Cells(m, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
bul2(m) = Sheets("MÜŞTERİ").Cells(m, "b") & deg1
bul3(m) = Sheets("MÜŞTERİ").Cells(m, "a") & deg1
bul4(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b") & deg1
bul5(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b")

Next m


For r = 2 To son1
For i = 2 To son2

If bul2(i) = ara2(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 33
Sheets("TEST").Cells(r, "d") = "Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 33
Sheets("MÜŞTERİ").Cells(i, "d") = "Fatura numarası ve tutarı birebir tutanlar"

End If


If bul3(i) = ara3(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 53
Sheets("TEST").Cells(r, "d") = "Tarih  ve tutarı hiç tutmayanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 53
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih  ve tutarı hiç tutmayanlar"

If bul4(i) <> ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 46
Sheets("TEST").Cells(r, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 46
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
End If
End If


If bul5(i) = ara5(r) Then
If bul4(i) <> ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 54
Sheets("TEST").Cells(r, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 54
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
End If
End If

If bul4(i) = ara4(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 43
Sheets("TEST").Cells(r, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 43
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
End If
Next i

Next r


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla)

End Sub

Run time error "9"

subscript out of range hatası veriyor

"bul1(m) = Sheets("MÜŞTERİ").Cells(m, "a") & Sheets("MÜŞTERİ").Cells(m, "b") & deg1" bu satır iç

halit3 · 18 Nisan 2015

buradaki aldığım örnek dosyayıda ekliyorum.
ayrıca kudu birazcık daha kısalttım.

Kod:

Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("MÜŞTERİ").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("TEST").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("MÜŞTERİ").Columns("D:D").ClearContents
Sheets("TEST").Columns("D:D").ClearContents

son2 = Sheets("MÜŞTERİ").Cells(Rows.Count, "a").End(3).Row
son1 = Sheets("TEST").Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1): ReDim ara4(son1)
ReDim bul1(son1): ReDim bul2(son1): ReDim bul3(son1): ReDim bul4(son1)

For j = 2 To son1

deg1 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "a"))
deg2 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "b"))
deg3 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "c"))

ara1(j) = deg1 & deg2 & deg3

If ara1(j) = "" Then
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 48
Sheets("TEST").Cells(j, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
ara2(j) = deg2 & deg3
ara3(j) = deg1 & deg3
ara4(j) = deg1 & deg2

Next j

For m = 2 To son2

deg4 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "a"))
deg5 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "b"))
deg6 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "c"))
If deg6 < 0 Then
deg7 = Math.Abs(deg6)
Else
deg7 = deg6
End If

bul1(m) = deg4 & deg5 & deg7
If bul1(m) = "" Then
Sheets("MÜŞTERİ").Cells(m, "d").Interior.ColorIndex = 48
Sheets("MÜŞTERİ").Cells(m, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
bul2(m) = deg5 & deg7
bul3(m) = deg4 & deg7
bul4(m) = deg4 & deg5

Next m


For r = 2 To son1
For i = 2 To son2

If bul2(i) = ara2(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 33
Sheets("TEST").Cells(r, "d") = "Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 33
Sheets("MÜŞTERİ").Cells(i, "d") = "Fatura numarası ve tutarı birebir tutanlar"

End If


If bul3(i) = ara3(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 53
Sheets("TEST").Cells(r, "d") = "Tarih  ve tutarı hiç tutmayanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 53
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih  ve tutarı hiç tutmayanlar"

If bul1(i) <> ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 46
Sheets("TEST").Cells(r, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 46
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
End If
End If


If bul4(i) = ara4(r) Then
If bul1(i) <> ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 54
Sheets("TEST").Cells(r, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 54
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
End If
End If

If bul1(i) = ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 43
Sheets("TEST").Cells(r, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 43
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
End If
Next i

Next r


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla)

End Sub

tigiy · 18 Nisan 2015

halit3' Alıntı:

buradaki aldığım örnek dosyayıda ekliyorum.
ayrıca kudu birazcık daha kısalttım.

Kod:

Sub Gruplandir()

ZBasla = TimeValue(Now)
zaman = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("MÜŞTERİ").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("TEST").Columns("A:D").Interior.ColorIndex = xlNone
Sheets("MÜŞTERİ").Columns("D:D").ClearContents
Sheets("TEST").Columns("D:D").ClearContents

son2 = Sheets("MÜŞTERİ").Cells(Rows.Count, "a").End(3).Row
son1 = Sheets("TEST").Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1): ReDim ara4(son1)
ReDim bul1(son1): ReDim bul2(son1): ReDim bul3(son1): ReDim bul4(son1)

For j = 2 To son1

deg1 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "a"))
deg2 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "b"))
deg3 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "c"))

ara1(j) = deg1 & deg2 & deg3

If ara1(j) = "" Then
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 48
Sheets("TEST").Cells(j, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
ara2(j) = deg2 & deg3
ara3(j) = deg1 & deg3
ara4(j) = deg1 & deg2

Next j

For m = 2 To son2

deg4 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "a"))
deg5 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "b"))
deg6 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "c"))
If deg6 < 0 Then
deg7 = Math.Abs(deg6)
Else
deg7 = deg6
End If

bul1(m) = deg4 & deg5 & deg7
If bul1(m) = "" Then
Sheets("MÜŞTERİ").Cells(m, "d").Interior.ColorIndex = 48
Sheets("MÜŞTERİ").Cells(m, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
End If
bul2(m) = deg5 & deg7
bul3(m) = deg4 & deg7
bul4(m) = deg4 & deg5

Next m


For r = 2 To son1
For i = 2 To son2

If bul2(i) = ara2(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 33
Sheets("TEST").Cells(r, "d") = "Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 33
Sheets("MÜŞTERİ").Cells(i, "d") = "Fatura numarası ve tutarı birebir tutanlar"

End If


If bul3(i) = ara3(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 53
Sheets("TEST").Cells(r, "d") = "Tarih  ve tutarı hiç tutmayanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 53
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih  ve tutarı hiç tutmayanlar"

If bul1(i) <> ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 46
Sheets("TEST").Cells(r, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 46
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
End If
End If


If bul4(i) = ara4(r) Then
If bul1(i) <> ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 54
Sheets("TEST").Cells(r, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 54
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
End If
End If

If bul1(i) = ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 43
Sheets("TEST").Cells(r, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 43
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
End If
Next i

Next r


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla)

End Sub

Hocam sizin kodunuzda da aynı hata mevcut

http://www.excel.web.tr/f48/ki-listeyi-belirli-kriterlere-gore-kar-yla-tyrma-t148299/post806533.html

bu mesajda açıklamaya çalıştım hatayı

halit3 · 18 Nisan 2015

kod bende hata vermedi örnek dosyayı da ekledim

tigiy · 18 Nisan 2015

halit3' Alıntı:
kod bende hata vermedi örnek dosyayı da ekledim

Hocam hata veriyor derken makro hata vermiyor söyle açıklayayım sizin gönderdiğiniz örnekte makro çalıştırın sonuçlarda her iki sayfada 3 kriter tutanları filtreleyin aynı olmadığını göreceksiniz

halit3 · 18 Nisan 2015

video görüntülerini açmak için hepsini indirin ve rar dan çıkartın

halit3 · 18 Nisan 2015

tigiy' Alıntı:
Hocam hata veriyor derken makro hata vermiyor söyle açıklayayım sizin gönderdiğiniz örnekte makro çalıştırın sonuçlarda her iki sayfada 3 kriter tutanları filtreleyin aynı olmadığını göreceksiniz

böyle anlamak zor

TEST ve MÜŞTERİ sayfasında hangi satırda olması gereken olmamış veya yanlış olmuş

en öndeki satırlardan bir iki satır numarası veriniz.

yani TEST sayfası 6 satır MÜŞTERİ sayfası 13 satır biri biriyle aynı

bunun gibi hangi satırlarda tutarsızlıklar var.

tigiy · 18 Nisan 2015

halit3' Alıntı:
böyle anlamak zor

TEST ve MÜŞTERİ sayfasında hangi satırda olması gereken olmamış veya yanlış olmuş

en öndeki satırlardan bir iki satır numarası veriniz.

yani TEST sayfası 6 satır MÜŞTERİ sayfası 13 satır biri biriyle aynı

bunun gibi hangi satırlarda tutarsızlıklar var.

Hocam hatayı örnekledim ve eke koydum.

Test sayfasında 13. satır

Müşteri sayfasında 15 ,264,265. satıra bakın

test sayfasındaki "Tarih, Fatura numarası ve tutarı birebir tutanlar" olmalıydı

Müşteri sayfası doğru

halit3 · 18 Nisan 2015

Test sayfasında 13 satırda aynen şöyle değer var.

tarih :04.01.2014
fatura no :9087
fatura tutarı :100,8

müşteri sayfasında 264 satırda şöyle değer var

tarih :04.01.2014
fatura no :9087-2
fatura tutarı :100,8 pazitif sayı

müşteri sayfasında 265 satırda şöyle değer var

tarih :04.01.2014
fatura no :9087-1
fatura tutarı :-100,8 nagatif sayı

neagatif ve pozitif sayaları kod aynı yapıyor ancak fatura noları hiç birbirine eşit değil

9087 test sayfası 13 satır
9087-2 müşteri sayfası 264 satır
9087-1 müşteri sayfası 265 satır

tigiy · 18 Nisan 2015

halit3' Alıntı:
Test sayfasında 13 satırda aynen şöyle değer var.

tarih :04.01.2014
fatura no :9087
fatura tutarı :100,8

müşteri sayfasında 264 satırda şöyle değer var

tarih :04.01.2014
fatura no :9087-2
fatura tutarı :100,8 pazitif sayı

müşteri sayfasında 265 satırda şöyle değer var

tarih :04.01.2014
fatura no :9087-1
fatura tutarı :-100,8 nagatif sayı

neagatif ve pozitif sayaları kod aynı yapıyor ancak fatura noları hiç birbirine eşit değil

9087 test sayfası 13 satır
9087-2 müşteri sayfası 264 satır
9087-1 müşteri sayfası 265 satır

Evet hocam haklısınız işte bende onu diyorum Test 13 ile müşteri 15 birebir aynı. Müşteri sayfasında sonuç doğru ama test sayfasında yanlış.
Yanlış çünkü 264 ve 265 değerlerde tarih ve tutarları tutuyor.

Benim istediğim test 13ünde aynı müşteri 15 deki gibi olması

halit3 · 18 Nisan 2015

yani kod
9087-2 müşteri sayfası 264 satır
9087-1 müşteri sayfası 265 satır

bunları böylemi görmesi gerekiyor.

9087 müşteri sayfası 264 satır
9087 müşteri sayfası 265 satır

halit3 · 18 Nisan 2015

Birde bu kodu dene

Kod:

Sub Gruplandir6()

ZBasla = TimeValue(Now)
zaman = Timer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Sheets("MÜŞTERİ").Columns("A:e").Interior.ColorIndex = xlNone
Sheets("TEST").Columns("A:e").Interior.ColorIndex = xlNone
Sheets("MÜŞTERİ").Columns("d:e").ClearContents
Sheets("TEST").Columns("d:e").ClearContents

son2 = Sheets("MÜŞTERİ").Cells(Rows.Count, "a").End(3).Row
son1 = Sheets("TEST").Cells(Rows.Count, "a").End(3).Row

ReDim ara1(son1): ReDim ara2(son1): ReDim ara3(son1): ReDim ara4(son1): ReDim ara5(son1)
ReDim bul1(son2): ReDim bul2(son2): ReDim bul3(son2): ReDim bul4(son2): ReDim bul5(son2): ReDim bul6(son2): ReDim bul7(son2): ReDim bul8(son2)
ReDim veri1(son1): ReDim veri2(son1): ReDim veri3(son1): ReDim veri4(son2): ReDim veri5(son2): ReDim veri6(son2)


For j = 2 To son1

deg1 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "a"))
deg2 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "b"))
deg3 = WorksheetFunction.Trim(Sheets("TEST").Cells(j, "c"))

veri1(j) = deg1
veri2(j) = deg2
veri3(j) = deg3

If deg3 = 0 Then deg3 = ""
ara1(j) = deg1 & deg2 & deg3

If ara1(j) = "" Then
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 48
Sheets("TEST").Cells(j, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
Sheets("TEST").Cells(j, "e") = "Yok"
End If
ara2(j) = deg2 & deg3
ara3(j) = deg1 & deg3
ara4(j) = deg1 & deg2

If ara2(j) = "" Then
Sheets("TEST").Cells(j, "b").Interior.ColorIndex = 6
Sheets("TEST").Cells(j, "c").Interior.ColorIndex = 6
Sheets("TEST").Cells(j, "d").Interior.ColorIndex = 6
Sheets("TEST").Cells(j, "e") = "Boş"
End If
ara5(j) = 1

Next j




For m = 2 To son2

deg4 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "a"))
deg5 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "b"))
deg6 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "c"))


veri4(m) = deg4
veri5(m) = deg5
veri6(m) = deg6

'veri1 = WorksheetFunction.Trim(Sheets("MÜŞTERİ").Cells(m, "b"))
'veri2 = Split(veri1, "-")
'If UBound(veri2) > 0 Then
'deg5 = veri2(0) * 1
'Else
'deg5 = veri1
'End If

'Sheets("MÜŞTERİ").Cells(m, "c") = Math.Abs(deg6)
If deg6 < 0 Then
deg7 = Math.Abs(deg6)
Else
deg7 = deg6
End If


If deg7 = 0 Then deg7 = ""

bul1(m) = deg4 & deg5 & deg7
If bul1(m) = "" Then
Sheets("MÜŞTERİ").Cells(m, "d").Interior.ColorIndex = 48
Sheets("MÜŞTERİ").Cells(m, "d") = "Tarih, Fatura numarası ve tutarı olmayanlar"
Sheets("MÜŞTERİ").Cells(m, "e") = "Yok"
End If
bul2(m) = deg5 & deg7
bul3(m) = deg4 & deg7
bul4(m) = deg4 & deg5

If bul2(m) = "" Then
Sheets("MÜŞTERİ").Cells(j, "b").Interior.ColorIndex = 6
Sheets("MÜŞTERİ").Cells(j, "c").Interior.ColorIndex = 6
Sheets("MÜŞTERİ").Cells(j, "d").Interior.ColorIndex = 6

Sheets("MÜŞTERİ").Cells(m, "e") = "Boş"
End If

bul5(m) = 1
bul6(m) = 1
bul7(m) = 1
bul8(m) = 1
Next m


For r = 2 To son1
For i = 2 To son2
If bul5(i) = 1 Then
If bul2(i) = ara2(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 33
Sheets("TEST").Cells(r, "d") = "Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 33
Sheets("MÜŞTERİ").Cells(i, "d") = "Fatura numarası ve tutarı birebir tutanlar"

If Sheets("TEST").Cells(r, "e") = "" Then
Sheets("TEST").Cells(r, "e") = i & Sheets("TEST").Cells(r, "e")
Else
Sheets("TEST").Cells(r, "e") = Sheets("TEST").Cells(r, "e") & "_" & i
End If

If Sheets("MÜŞTERİ").Cells(i, "e") = "" Then
Sheets("MÜŞTERİ").Cells(i, "e") = r & Sheets("MÜŞTERİ").Cells(i, "e")
Else
Sheets("MÜŞTERİ").Cells(i, "e") = Sheets("MÜŞTERİ").Cells(i, "e") & "_" & r
End If
bul5(i) = 0

End If
End If
Next i
Next r


For r = 2 To son1
For i = 2 To son2
If bul6(i) = 1 Then

If bul4(i) = ara4(r) And veri3(r) <> veri6(i) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 54
Sheets("TEST").Cells(r, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 54
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve fatura numarası aynı olup tutarı farklı olanlar"

If Sheets("TEST").Cells(r, "e") = "" Then
Sheets("TEST").Cells(r, "e") = i & Sheets("TEST").Cells(r, "e")
Else
Sheets("TEST").Cells(r, "e") = Sheets("TEST").Cells(r, "e") & "_" & i
End If

If Sheets("MÜŞTERİ").Cells(i, "e") = "" Then
Sheets("MÜŞTERİ").Cells(i, "e") = r & Sheets("MÜŞTERİ").Cells(i, "e")
Else
Sheets("MÜŞTERİ").Cells(i, "e") = Sheets("MÜŞTERİ").Cells(i, "e") & "_" & r
End If

bul6(i) = 0

End If
End If
Next i
Next r



For r = 2 To son1
For i = 2 To son2
If bul7(i) = 1 Then

If bul3(i) = ara3(r) And veri2(r) <> veri5(i) Then

Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 46
Sheets("TEST").Cells(r, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 46
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar"

If Sheets("TEST").Cells(r, "e") = "" Then
Sheets("TEST").Cells(r, "e") = i & Sheets("TEST").Cells(r, "e")
Else
Sheets("TEST").Cells(r, "e") = Sheets("TEST").Cells(r, "e") & "_" & i
End If

If Sheets("MÜŞTERİ").Cells(i, "e") = "" Then
Sheets("MÜŞTERİ").Cells(i, "e") = r & Sheets("MÜŞTERİ").Cells(i, "e")
Else
Sheets("MÜŞTERİ").Cells(i, "e") = Sheets("MÜŞTERİ").Cells(i, "e") & "_" & r
End If

bul7(i) = 0

End If
End If
Next i
Next r





For r = 2 To son1
For i = 2 To son2
If bul8(i) = 1 Then

If bul1(i) = ara1(r) Then
Sheets("TEST").Cells(r, "d").Interior.ColorIndex = 43
Sheets("TEST").Cells(r, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"
Sheets("MÜŞTERİ").Cells(i, "d").Interior.ColorIndex = 43
Sheets("MÜŞTERİ").Cells(i, "d") = "Tarih, Fatura numarası ve tutarı birebir tutanlar"

ara5(r) = 43
bul5(i) = 43
If Sheets("TEST").Cells(r, "e") = "" Then
Sheets("TEST").Cells(r, "e") = i & Sheets("TEST").Cells(r, "e")
Else
Sheets("TEST").Cells(r, "e") = Sheets("TEST").Cells(r, "e") & "_" & i
End If

If Sheets("MÜŞTERİ").Cells(i, "e") = "" Then
Sheets("MÜŞTERİ").Cells(i, "e") = r & Sheets("MÜŞTERİ").Cells(i, "e")
Else
Sheets("MÜŞTERİ").Cells(i, "e") = Sheets("MÜŞTERİ").Cells(i, "e") & "_" & r
End If

bul8(i) = 0

End If
End If
Next i
Next r


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

zBitis = TimeValue(Now)

MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & _
"İşlem süresi ; " & Format(Timer - zaman, "0.00") & Chr(10) & _
"Geçen Süre " & CDate(zBitis - ZBasla)

End Sub

tigiy · 18 Nisan 2015

halit3' Alıntı:
yani kod
9087-2 müşteri sayfası 264 satır
9087-1 müşteri sayfası 265 satır

bunları böylemi görmesi gerekiyor.

9087 müşteri sayfası 264 satır
9087 müşteri sayfası 265 satır

Hayır hocam o şekilde göremeyecek nasılsa o şekilde görmeli.

eke resim koydum siz aynı değil demişsiniz ama test 13 müşteri 15 birebir aynı

test 13ün sonucu test 15 ile aynı olmalı.

halit3 · 18 Nisan 2015

tigiy' Alıntı:
Hayır hocam o şekilde göremeyecek nasılsa o şekilde görmeli.

eke resim koydum siz aynı değil demişsiniz ama test 13 müşteri 15 birebir aynı

test 13ün sonucu test 15 ile aynı olmalı.

Kelimeleri yanlış yazıyorsunuz bende anlayamıyorum.

Sayfa isimlerini tam yazın

bu ne anlamadım (test 13ün sonucu test 15 ile aynı olmalı)
ben müşteri 15 satırı için hiç bir şey yazmadım.

tigiy · 19 Nisan 2015

halit3' Alıntı:
Kelimeleri yanlış yazıyorsunuz bende anlayamıyorum.

Sayfa isimlerini tam yazın

bu ne anlamadım (test 13ün sonucu test 15 ile aynı olmalı)
ben müşteri 15 satırı için hiç bir şey yazmadım.

Hocam anlayamadığınız bölüm neresi ise elimden geldiğince açıklamaya çalışayım

son eklediğim resimi açıklamak gerekirse;

sol taraftaki "TEST" Sayfası yani sayfa1 de gördüğünüz gibi 13. satır

"04.01.2014" "9087" "100,80"

Sağ taraftaki ise "MÜŞTERİ" sayfası yani sayfa2 13. satır da

"04.01.2014" "9087" "100,80" yani birebir aynı.

Her iki sayfa içinde "D" yani sonuç bölümünde "Tarih, Fatura numarası ve tutarı birebir tutanlar" yazmalı. Ancak sadece sayfa 2.de 15. satıra yazmış

sayfa1de ise "Tarihi ve tutarı aynı olan fatura numarasında farklılık olanlar" yazmış

İki Listeyi Belirli kriterlere göre karşılaştırma

numan şamil

Destek Ekibi

Ekli dosyalar

tigiy

numan şamil

Destek Ekibi

tigiy

halit3

Uzman

tigiy

halit3

Uzman

Ekli dosyalar

tigiy

halit3

Uzman

tigiy

halit3

Uzman

halit3

Uzman

tigiy

Ekli dosyalar

halit3

Uzman

tigiy

halit3

Uzman

halit3

Uzman

tigiy

Ekli dosyalar

halit3

Uzman

tigiy