kod' ta güncelleme

[igultekin2000]

iyi günler; kullanmakta olduğum kod' ta işlemde eşleşen değerleri tespit edip eşleşen sayfasına aktarıyor, aynı anda eşleşmeyenleri de tespit edip eşleşmeyenler sayfasına aktarması da gerekiyor. deneme yaptım ama sonuç alamadım Teşekkürler.

Sub işlem()
Application.ScreenUpdating = False
On Error Resume Next
Call analiz
Call sayfaya_gönder
Application.ScreenUpdating = True
End Sub
Sub analiz()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("MASTER").Range("f2:ı65536").ClearContents
'Sheets("MASTER").Range("a2:e65536").Interior.ColorIndex = xlNone

Set s1 = ThisWorkbook.Worksheets("MASTER")
For i = 2 To s1.Range("A65536").End(xlUp).Row
If s1.Cells(i, "c") <> "" Then s1.Cells(i, "f") = s1.Cells(i, "a") & "_" & s1.Cells(i, "c")
If s1.Cells(i, "d") <> "" Then s1.Cells(i, "g") = s1.Cells(i, "a") & "_" & Abs(s1.Cells(i, "d"))
Next i
sonn = s1.Range("a65536").End(xlUp).Row
For i = 2 To sonn
For k = 2 To sonn
If s1.Cells(i, "f") <> "" And WorksheetFunction.CountIf(s1.Range("g2:g" & k), s1.Cells(i, "f")) = 1 And s1.Cells(i, "h") = "" Then
s1.Cells(i, "h") = s1.Cells(i, "f") & WorksheetFunction.CountIf(s1.Range("f2:f" & i), s1.Cells(i, "f"))
End If
Next k
Next i
For i = 2 To sonn
For k = 2 To sonn
If s1.Cells(i, "g") <> "" And WorksheetFunction.CountIf(s1.Range("f2:f" & k), s1.Cells(i, "g")) = 1 And s1.Cells(i, "ı") = "" Then
s1.Cells(i, "ı") = s1.Cells(i, "g") & WorksheetFunction.CountIf(s1.Range("g2:g" & i), s1.Cells(i, "g"))
End If
Next k
Next i
Application.ScreenUpdating = True
End Sub

Sub sayfaya_gönder()
Application.ScreenUpdating = False
On Error Resume Next
Set s1 = ThisWorkbook.Worksheets("MASTER")
Set s2 = ThisWorkbook.Worksheets("eşleşenler")

say = 0
For i = 2 To s1.Range("h65536").End(xlUp).Row
For k = 2 To s1.Range("ı65536").End(xlUp).Row

If s1.Cells(i, "j") = "" And s1.Cells(i, "h") <> "" And s1.Cells(i, "h") = s1.Cells(k, "ı") Then
sonsatir = s2.Range("A65536").End(xlUp).Row + 1
s2.Cells(sonsatir, 1) = s1.Cells(i, 1)
s2.Cells(sonsatir, 2) = s1.Cells(i, 2)
s2.Cells(sonsatir, 3) = s1.Cells(i, 3)
s2.Cells(sonsatir, 4) = s1.Cells(i, 4)
s2.Cells(sonsatir, 5) = s1.Cells(i, 5)
s2.Range("a" & sonsatir & ":e" & sonsatir).Interior.ColorIndex = s1.Cells(1, "c").Interior.ColorIndex
s1.Cells(i, "j") = 1
s1.Range("a" & i & ":e" & i).Interior.ColorIndex = s1.Cells(1, "c").Interior.ColorIndex

s2.Cells(sonsatir, 6) = s1.Cells(k, 1)
s2.Cells(sonsatir, 7) = s1.Cells(k, 2)
s2.Cells(sonsatir, 8) = s1.Cells(k, 3)
s2.Cells(sonsatir, 9) = s1.Cells(k, 4)
s2.Cells(sonsatir, 10) = s1.Cells(k, 5)
say = say + 1
s1.Range("a" & k & ":e" & k).Interior.ColorIndex = s1.Cells(1, "d").Interior.ColorIndex
s2.Range("f" & sonsatir & ":j" & sonsatir).Interior.ColorIndex = s1.Cells(1, "d").Interior.ColorIndex

End If
Next k
Next i
Application.ScreenUpdating = True
If say >= 1 Then MsgBox (say & " Adet eşleşen veri sayfalara gönderildi.")
If say = 0 Then MsgBox ("Sayfalara tasniflenecek veri BULUNAMADI."), vbCritical
End Sub

Sub işlemleri_temizle()
Sheets("MASTER").Range("f2:j65536").ClearContents
Sheets("MASTER").Range("a2:e65536").Interior.ColorIndex = xlNone
Sheets("eşleşenler").Range("a2:j65536").ClearContents
Sheets("eşleşenler").Range("a2:j65536").Interior.ColorIndex = xlNone

End Sub

 

[Ömer BARAN]

Merhaba.

Aşağıdaki kod'un işinizi görmesi gerekir.
Varsa, eşleşenler ve eşleşmeyenler sayfalarında mevcut verilerinizi başka alana/sayfaya aktarmadan kod'u çalıştırmayın..

Sub eslesen_eslesmeyen()
Set m = Sheets("MASTER"): Set e = Sheets("eşleşenler"): Set em = Sheets("eşleşmeyenler")
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
mson = m.Cells(Rows.Count, 1).End(3).Row
e.Cells.Clear: em.Cells.Clear
m.[A1:E1].Copy e.[A1]: m.[A1:E1].Copy e.[F1]: m.Range("A1:E" & mson).Copy em.[A1]
em.Range("A2:E" & mson).Sort em.[A2], 1
For sat = 2 To mson
    son = sat - 1 + WorksheetFunction.CountIf(em.[A:A], em.Cells(sat, 1))
    For brn = sat To son
        If em.Cells(brn, 3) <> "" Then
            deg = -1 * em.Cells(brn, 3)
                If WorksheetFunction.CountIf(em.Range("D" & sat & ":D" & son), deg) > 0 Then
                    bbrn = sat - 1 + WorksheetFunction.Match(deg, em.Range("D" & sat & ":D" & son), 0)
                    esat = e.Cells(Rows.Count, 1).End(3).Row + 1
                    em.Range("A" & bbrn & ":E" & bbrn).Cut: e.Cells(esat, 6).Insert Shift:=xlDown
                    em.Range("A" & brn & ":E" & brn).Cut: e.Cells(esat, 1).Insert Shift:=xlDown
                Else
                End If
        End If
    Next
    If sat = son Then Exit For
    sat = son
Next
em.Columns.AutoFit: e.Columns.AutoFit
emyenison = em.Cells(Rows.Count, 1).End(3).Row
em.Range("A2:K" & mson).Sort em.[A2], 1
em.Range("A" & em.Cells(Rows.Count, 1).End(3).Row + 1 & ":E" & emyenison).Clear
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "İşlem Tamamlandı.", vbInformation, "..:: Ömer BARAN ::.."
End Sub

 

[igultekin2000]

Ömer BARAN

Teşekkür ederim Ömer Bey makro sorunsuz çalışıyor. Hayırlı akşamlar

 

[Ömer BARAN]

Eyvallah, güle güle kullanın.

Makronun çalışma mekanizmasını da kısaca şöyle özetleyebiliriz.
-- Verilerin tümü eşleşmeyenler sayfasına alınıp, tarihe göre sıralanır,
-- Tarih grupları içerisinde eşleşen araması yapılıp, bulunanlar eşleşenler sayfasına KES-YAPIŞTIR ile aktarılır.
-- Kalan satırlar eşleşmeyenlerdir zaten,
-- Eşleşmeyenler sayfası tekrar sıralanır (.öylece boş satırlar alta gider), boş satırlar tamamen silinir.
.

 

[igultekin2000]

Eyvallah, güle güle kullanın.

Makronun çalışma mekanizmasını da kısaca şöyle özetleyebiliriz.
-- Verilerin tümü eşleşmeyenler sayfasına alınıp, tarihe göre sıralanır,
-- Tarih grupları içerisinde eşleşen araması yapılıp, bulunanlar eşleşenler sayfasına KES-YAPIŞTIR ile aktarılır.
-- Kalan satırlar eşleşmeyenlerdir zaten,
-- Eşleşmeyenler sayfası tekrar sıralanır (.öylece boş satırlar alta gider), boş satırlar tamamen silinir.
.

iyi günler; örnekte sorunsuz çalışıyordu, başka bir çalışma yaptığımda hepsini eşleşmeyenler sayfasına atıyor, eşleştirme yapmıyor. Sorunu çözemedim.

 

[Ömer BARAN]

Şu an bilgisayar başında değilim ve örnek belgenize bakıp cevap yazmam mümkün değil.
Müsait olduğumda bakarım.
Tümünü eşleşmeyenler sayfasına atması normal.
Bir önceki cevabımda kodun çalışma mantığını açıklamıştım, tekrar okuyunuz.
Kuvvetle muhtemel son belgenizdeki veri alanı farklı yapıda ya da tarihler ta6ih gibi görünse de tarih değil, başka bir nereni olacağını sanmıyorum.
Kodu elle adım adım çamıştırın, For... satırına gel5iğinde, eşleşmeyenler sayfasında tarihe göre sıralanmış olup olmadığnı görebilirsiniz.
Eğer sıralanmamıysa tarihlerde, veya bırç alacak sütunlarının konumları örnek ilk örnek belgeye göde farklıdır.

 

[Ömer BARAN]

Merhaba.

Kod'un sonuna yakın, son NEXT satırının iki üstündeki If sat = son Then Exit For şeklindeki aşağıdaki satırı silerek dener misiniz?
.

 

[igultekin2000]

Merhaba.

Kod'un sonuna yakın, son NEXT satırının iki üstündeki If sat = son Then Exit For şeklindeki aşağıdaki satırı silerek dener misiniz?
.

Teşekkürler, o şekilde sorunsuz çalıştı. Hayırlı geceler

 

[Ömer BARAN]

Bilmukabele.