Sayfa karşılaştırma

[Duruöz]

Herkese merhabalar,
Üç sayfalı excel dosyam mevcut
Sabit isimli ve içerisinde binlerce verinin olduğu birinci sayfam
Talep isimli ve içerisindeki veri sayısının sürekli değiştiği ikinci sayfam
Üçüncü sonuç sayfam
Talep sayfasının içindeki verilerin Sabit isimli sayfanın içindeki verilerle karşılaştırarak sabit içerisinde olmayan veriyi sonuç sayfasına yazdırmak istiyorum
Çok teşekkürler
Saygılar
Örnek Dosyam

 

[YUSUF44]

Aşağıdaki makroyu deneyiniz:

Sub kontrol()
Set s1 = Sheets("sabit")
Set s2 = Sheets("talep")
Set s3 = Sheets("SONUC")
sonSA = s1.Cells(Rows.Count, "A").End(3).Row
sonSB = s1.Cells(Rows.Count, "B").End(3).Row

sonT = s2.Cells(Rows.Count, "A").End(3).Row
For t = 1 To sonT
    If WorksheetFunction.CountIf(s1.Range("A1:A" & sonSA), s2.Cells(t, "A")) = 0 Or _
        WorksheetFunction.CountIf(s1.Range("A1:A" & sonSB), s2.Cells(t, "A")) = 0 Then
        yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
        If s3.[A1] = "" Then yeni = 1
        s2.Cells(t, "A").Copy s3.Cells(yeni, "A")
    End If
Next

End Sub

Düzeltme: kodun ilk halinde For t = 11 to sonT idi, düzelttim.

 

[Duruöz]

Hocam öncelikle yardımlarınızda dolayı çok teşekkürler...
Fakat şöyle bir durum var sabitler ve talep kanalı çok sütunlu ve satırlı

 

[leguminosea]

Dosyanız ektedir.

ornek.xlsx dosyasını indir - download

ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

 

[YUSUF44]

Hocam öncelikle yardımlarınızda dolayı çok teşekkürler...
Fakat şöyle bir durum var sabitler ve talep kanalı çok sütunlu ve satırlı

Bunu daha önce belirtseydiniz ona göre ayarlamaya çalışırdım

Aşağıdaki kod talep sayfasının A1:C500 aralığındaki verileri sabit sayfasının A1:Z1000 aralığında arar. Kendinize göre hücre aralıklarını değiştirebilirsiniz. Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem uzun sürebilir:

Sub kontrol()
Application.ScreenUpdating = False
Set s1 = Sheets("sabit")
Set s2 = Sheets("talep")
Set s3 = Sheets("SONUC")
sonT = s2.Cells(Rows.Count, "A").End(3).Row
For Each hucre In s2.Range("A1:C500")
    If hucre <> "" Then
        If WorksheetFunction.CountIf(s1.Range("A1:Z1000"), hucre) = 0 Then
            yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
            If s3.[A1] = "" Then yeni = 1
            hucre.Copy s3.Cells(yeni, "A")
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

 

[Duruöz]

Dosyanız ektedir.

ornek.xlsx dosyasını indir - download

ornek.xlsx dosyasını indir, download. Dosya.tc .Dosya Upload. Dosya Paylaş. Dosya Yükle

s4.dosya.tc

Teşekkürler

 

[Duruöz]

Bunu daha önce belirtseydiniz ona göre ayarlamaya çalışırdım

Aşağıdaki kod talep sayfasının A1:C500 aralığındaki verileri sabit sayfasının A1:Z1000 aralığında arar. Kendinize göre hücre aralıklarını değiştirebilirsiniz. Verilerinizin çokluğuna ve bilgisayarınızın durumuna göre işlem uzun sürebilir:

Sub kontrol()
Application.ScreenUpdating = False
Set s1 = Sheets("sabit")
Set s2 = Sheets("talep")
Set s3 = Sheets("SONUC")
sonT = s2.Cells(Rows.Count, "A").End(3).Row
For Each hucre In s2.Range("A1:C500")
    If hucre <> "" Then
        If WorksheetFunction.CountIf(s1.Range("A1:Z1000"), hucre) = 0 Then
            yeni = s3.Cells(Rows.Count, "A").End(3).Row + 1
            If s3.[A1] = "" Then yeni = 1
            hucre.Copy s3.Cells(yeni, "A")
        End If
    End If
Next
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı"
End Sub

Çok çok teşekkürler ....yüreğinize sağlık sağ olun var olun...