Çok satırlı Karşılaştırma

[acar6783]

Boşluk karakter sorunu olabilir.

krt = a(i, 5) & "|" & a(i, 7) satırını krt = Application.Trim(a(i, 5)) & "|" & a(i, 7)

krt = b(i, 4) & "|" & b(i, 6) satırını krt = Application.Trim(b(i, 4)) & "|" & b(i, 6)

şeklinde deneyiniz.

Aslında sorun boşluk değil. Bir tarafta olup diğer tarafta olmayanlardan sadece bir tanesinin gelmiş olması. Halbuki karşılaştırma her ikisini de getirmesi gerekiyordu.

 

[Ziynettin]

"Muavin" ve "ekstre" sayfalarında birbirinde olmayanları listeler.

Sub olmayanlar()
Dim a(), b(), c(), d As Object
Dim i As Long, say As Long
With Sheets("HATALAR")
If .Cells(Rows.Count, 1).End(3).Row > 5 Then .Range("A6:H" & .Cells(Rows.Count, 1).End(3).Row).Clear
zaman = Timer
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False

MY = ThisWorkbook.Path & "\108 MUAVİN.xlsx"
Set wb2 = Workbooks.Open(MY)
mson = wb2.Sheets("MUAVİN").Cells(Rows.Count, "A").End(3).Row
a = wb2.Sheets("MUAVİN").Range("A7:I" & mson).Value
wb2.Close 0

EY = ThisWorkbook.Path & "\108 EKSTRE.xlsx"
Set wb1 = Workbooks.Open(EY)
eson = wb1.Sheets("EKSTRE").Cells(Rows.Count, "A").End(3).Row
b = wb1.Sheets("EKSTRE").Range("A7:H" & eson).Value
wb1.Close 0

  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(a) 'muavin
        If a(i, 5) <> "Devir" Then
            krt = a(i, 5) & "|" & a(i, 7)
            d1(krt) = krt
        End If
    Next i
    
  satir = UBound(a) + UBound(b)
  ReDim c(1 To satir, 1 To 8)
 
    For i = 1 To UBound(b) 'ekstre
        If b(i, 4) <> "Devir" Then
        krt = b(i, 4) & "|" & b(i, 6)
            If Not d1.exists(krt) Then '
                say = say + 1
                c(say, 1) = b(i, 1)
                c(say, 2) = b(i, 2)
                c(say, 3) = b(i, 3)
                c(say, 4) = b(i, 4)
                c(say, 5) = b(i, 6)
                c(say, 6) = b(i, 7)
                c(say, 7) = b(i, 8)
                c(say, 8) = "EKSTRE"
            End If
            d2(krt) = ""
        End If
    Next i
  say = say + 1
    For i = 1 To UBound(a) 'muavin
        If a(i, 5) <> "Devir" Then
            krt = a(i, 5) & "|" & a(i, 7)
            If Not d2.exists(krt) Then
                say = say + 1
                c(say, 1) = a(i, 1)
                c(say, 2) = a(i, 3)
                c(say, 3) = a(i, 4)
                c(say, 4) = a(i, 5)
                c(say, 5) = a(i, 7)
                c(say, 6) = a(i, 8)
                c(say, 7) = a(i, 9)
                c(say, 8) = "MUAVİN"
            End If
        End If
    Next i

If say > 0 Then
    .[A6].Resize(say).NumberFormat = "dd.mm.yyyy"
    .[E6].Resize(say, 3).NumberFormat = "#,##0.00"
    .[A6].Resize(say, 8) = c
End If

Erase a: Erase b: Erase c
Set d = Nothing: MY = Empty: EY = Empty: Set wb1 = Nothing: Set wb2 = Nothing
say = Empty: mson = Empty: eson = Empty: i = Empty: j = Empty
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
MsgBox "Listeleme tamamlandı." & vbLf & _
"İşlem süresi: " & Format(Timer - zaman, "0.00") & " saniye", vbInformation, "..:: Ömer BARAN ::.."
zaman = Empty
End With
End Sub

 

[acar6783]

Çok teşekkür ederim Hemşerim

 

[muzaffer.sm]

Merhabalar,

Bu konuyu biraz incelemek istedim.Konu gereği şahsıma lazım olabilecek bir çalışma.Güncel hali hangi mesajda ? Bende bu çalışmadan faydalanmak istiyorum.Mesleki gereği önemli bir uygulama

 

[Ömer BARAN]

Bu konuyu biraz incelemek istedim.Konu gereği şahsıma lazım olabilecek bir çalışma.Güncel hali hangi mesajda ? Bende bu çalışmadan faydalanmak istiyorum.Mesleki gereği önemli bir uygulama

Sizin mesajınıza kadar, konu sahibinin karşılıklı arama/listeleme isteğinin olduğunu fark etmemiş, konuyu ÇÖZÜLDÜ hanesine ayırmıştım kafamda.
Zira benim verdiğim kodlar ve belgeler ile Sayın @Ziynettin'in önceki cevaplarda verdiği kodlar,
tek taraflı kontrole yönelik idi ve konu sahibi de sorunun çözüldüğü mesajını yazmıştı.

Sayın @Ziynettin 'in son cevap olarak verdiği kod, karşılıklı arama ve olmayanları listeleme işlemini yapar durumda.
Son cevaptaki kodlar sorunsuz kullanılabilir.
NOT: Denemelerinizi, konu sahibinin eklediği örnek belgeleri kullanarak yapınız.

 

[gicimi]

Sayın @acar6783 bu çalışmadan faydalanmak istiyorum. Örnek Çalışmayı son hali ile paylaşabilir misiniz. Teşekkürler.

 

[acar6783]

https://yadi.sk/d/wCuETC5hnlBy9A

Buyrunuz...

 

[gicimi]

@acar6783 teşekkürler.