• DİKKAT

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

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

  • Konbuyu başlatan Konbuyu başlatan tigiy
  • Başlangıç tarihi Başlangıç tarihi
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ı
Genişletmek için tıkla ...

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ı
 

Ekli dosyalar

Son düzenleme:
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ı
Genişletmek için tıkla ...

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.
 
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.
Genişletmek için tıkla ...
Merhaba
41.Mesajdaki dosyayı yeniledim belki biraz daha hızlı çalışır
Tekrar bakabilir misiniz
Sonuçtan haberdar ederseniz sevinirim
İyi çalışmalar
 
Son düzenleme:
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
 
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
 
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
Genişletmek için tıkla ...

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ç
 
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
 

Ekli dosyalar

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
Genişletmek için tıkla ...


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ı
 
kod bende hata vermedi örnek dosyayı da ekledim
 
halit3' Alıntı:
kod bende hata vermedi örnek dosyayı da ekledim
Genişletmek için tıkla ...

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
 
video görüntülerini açmak için hepsini indirin ve rar dan çıkartın
 
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
Genişletmek için tıkla ...

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.
 
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.
Genişletmek için tıkla ...

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
 

Ekli dosyalar

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
 
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
Genişletmek için tıkla ...

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ı
 
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
 
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
 
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
Genişletmek için tıkla ...

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ı.
 

Ekli dosyalar

  • örnek.jpg
    örnek.jpg
    20.2 KB · Görüntüleme: 5
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ı.
Genişletmek için tıkla ...

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.
 
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.
Genişletmek için tıkla ...

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ış
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst