• DİKKAT

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

Veri kontrol

Katılım
26 Aralık 2008
Mesajlar
1,145
Excel Vers. ve Dili
EXCEL 2016 TÜRKÇE
Merhaba arkadaşlar ekte ki dosyada sayfa 1 ve Sayfa2 nin A sütunlarına veriler var Sayfa2 de sayfa1 in A sütunundaki 1586 ile 1100 yok Sayfa1 de ise sayfa2 nin A sütunundaki 1099 ile 1011 yok ben bunları sayfa3 e aktarmasını ve hangi sayfada olduğunu gösterhttp://s6.dosya.tc/server6/2cuxzw/VERI_KONTROL.xls.htmlmesini istiyorum Yardımcı olursanız sevinirim.
 
Merhaba,

Dosyanız ekte...

Kod:
Option Explicit

Sub Olmayanlar()
Dim S1 As Worksheet, S2 As Worksheet, S3 As Worksheet
Dim a(), b(), c(), d As Object
Dim i As Long, Say As Long

Application.ScreenUpdating = False
  
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
Set S3 = Sheets("Sayfa3")

a = S2.Range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row)
b = S1.Range("A2:A" & S1.Cells(Rows.Count, 1).End(3).Row)
  
Set d = CreateObject("Scripting.Dictionary")
ReDim c(1 To UBound(a) + UBound(b), 1 To 3)
  
    For i = 1 To UBound(a)
        d(a(i, 1)) = 1
    Next i
  
    For i = 1 To UBound(b)
        If Not d.exists(b(i, 1)) Then
            Say = Say + 1
            c(Say, 1) = b(i, 1)
            c(Say, 2) = S1.Name
            c(Say, 3) = "Satır :  " & i + 1
        End If
    Next i

Set d = CreateObject("Scripting.Dictionary")
  
    For i = 2 To UBound(b)
        d(b(i, 1)) = 1
    Next i
    
    For i = 2 To UBound(a)
        If Not d.exists(a(i, 1)) Then
            Say = Say + 1
            c(Say, 1) = a(i, 1)
            c(Say, 2) = S2.Name
            c(Say, 3) = "Satır :  " & i + 1
        End If
    Next

If Say > 0 Then
    S3.Range("A2:C" & Rows.Count).ClearContents
    S3.[A2].Resize(Say, 3) = c
Else
    MsgBox "Yazdırılacak Veri Bulunamadı", vbExclamation
    Exit Sub
End If
Application.ScreenUpdating = True
MsgBox "İşlem Tamam.", vbInformation

Set d = Nothing: i = Empty: Say = Empty
End Sub
 

Ekli dosyalar

çok teşekkür ederim kal sağlıcakla
 
Geri
Üst