İki ayrı excel belgesinde bulunan bilgileri karşılaştırarak farklı olanları listeleme

seenon72 · 28 Ocak 2010

Saygıdeğer arkadaşlar yardımlarınızı bekliyorum....

Benim sorunum şu:

Ben maaş işlemleri ile ilgili olarak çalışıyorum. Her ay maaş yapıldıktan sonra, maaş sistemimden maaş yapılan personelin bilgilerinin bulunduğu bir excel belgesi çıktısı alabiliyorum. Ancak geçen ay ile bu ay arasında birimler bazındaki değişiklikleri otomatik olarak çıkartabilecek bir kod vb. vardır diye düşünüyorum.

Örnek vermek gerekirse, A biriminden 1 personel ayrılıp, bu birime 2 personel gelmiş, bunları ayrı ayrı listeleyebilecek.
Yani ay içerisnde katılan personel:2, ay içerisinde ayrılan personel:1 gibi, ama tüm bilgileri ile birlikte, çünkü o excel belgesinde maaşıyla ilgili bir sürü veri var, onları da göstermesini istiyorum. Sadece sayı olarak değil yani komple satırı içersin istiyorum ve bunu da farklı bir çalışma sayfasında gösterebilmesi çok iyi olur.

Tabi bunun için TC Kimlik Numarasını esas alıp bir sorgulama yapabiliriz, maaş sisteminden aldığım excel belgesinde, kişinin adı soyadı, TC Kimlik nu., SGK nu.,çalıştığı birimi vb. bir sürü veri var.

Yardımcı olabilecek arkadaşlar varsa lütfen benden yardımlarını esirgemesinler.

Şimdiden çok teşekkür ediyorum.

seenon72 · 28 Ocak 2010

Lütfen yardımlarınızı bekliyorum

örnek dosyayı aşağıya ekledim.

2009 aralık ayında 5 kişi görünüyor.

2010 ocak ayında ise 6 kişi;

1. J...k... Kişisi ayrılıyor,

2. L..m... Ve n...o... Kişileri katılıyor.

Sonuç itibariyle ister tc kimlik nu., ister sgk.(emekli sandığı) nu. Baz alınarak bir karşılaştırma yapılıp,

yeni bir excel sayfasına;

1. Ay içinde çıkan personel: J...k... (aynı satırdaki tüm bilgilerle birlikte)

2. Ay içinde giren personel:

A. L...m... (aynı satırdaki tüm bilgilerle birlikte)

b. N...o... (aynı satırdaki tüm bilgilerle birlikte)

yazılmasını istiyorum.

Acilen yardımınızı bekliyorum.

seenon72 · 30 Ocak 2010

Yardım edecek kimse yok mu?

Orion1 · 30 Ocak 2010

Her 2 dosyada ayni klasörde olmalı.
Kodların çalışabilmesi için vbe de tools reference den microsoft activex dataobjext 2.x library seçilmeli.
Ben bu dosyada seçtim.
Çıkanlar bölümünü yaptım.
Aslında girenler bölümünüde yapmıştım ama çok miktarda verilerde kayıt kümesi ni açıp kapamak bir sakınca yaratırmı onu kestiremediğim için o kodları sildim.
Önceki ayı açılan listeden seçiniz.
Dosya ektedir.Diğer dosyayı açmanıza gerek yoktur.kapalı iken verielri rahatlıkla alabilyoruz.
Kodlar ocak dosyasındadır.

Kod:

Sub cikanlar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, j As Byte
Dim dosya, sat1 As Long, sat2 As Long, k As Range, sh As Worksheet
'vbe tools'tan reference'den microsoft activex dataobject 2.8 library seçildi.
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları," & _
        "*.xls", Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
If dosya = False Then
    MsgBox "Bir excel dosyası seçilmedi.İşlem yapılmadı.", vbCritical, "UYARI"
    Exit Sub
End If
Set sh = Sheets("GENEL")
sat1 = sh.Cells(65536, "F").End(xlUp).Row
sat2 = 2
Sheets("Çıkanlar").Select
Application.ScreenUpdating = False
Range("A2:IV65536").Clear
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & dosya & ";extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [GENEL$] order by ADISOYADI;", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then rs.MoveFirst
Do While Not rs.EOF
    Set k = sh.Range("F2:F" & sat1).Find(rs(5).Value, , xlValues, xlWhole)
    If k Is Nothing Then
        For j = 1 To rs.Fields.Count
            Cells(sat2, j).Value = rs(j - 1).Value
        Next
        sat2 = sat2 + 1
    End If
    rs.MoveNext
Loop
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Çıkanlar Listelendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub
Sub girenler()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, j As Byte
Dim dosya, sat1 As Long, sat2 As Long, k As Range, sh As Worksheet
'vbe tools'tan reference'den microsoft activex dataobject 2.8 library seçildi.
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları," & _
        "*.xls", Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
If dosya = False Then
    MsgBox "Bir excel dosyası seçilmedi.İşlem yapılmadı.", vbCritical, "UYARI"
    Exit Sub
End If
Set sh = Sheets("GENEL")
sat1 = sh.Cells(65536, "C").End(xlUp).Row
sat2 = 2
Sheets("Girenler").Select
Application.ScreenUpdating = False
Range("A2:IV65536").Clear
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & dosya & ";extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [GENEL$] order by ADISOYADI;", conn, adOpenKeyset, adLockReadOnly
For d = 2 To sat1
If rs.RecordCount > 0 Then rs.MoveFirst
    Do While Not rs.EOF
        If sh.Cells(d, "F").Value = rs(5).Value Then GoTo atla
        rs.MoveNext
    Loop
    For j = 1 To rs.Fields.Count
        Cells(sat2, j).Value = sh.Cells(d, j).Value
    Next
    sat2 = sat2 + 1
atla:
Next
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Çıkanlar Listelendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

seenon72 · 31 Ocak 2010

Evren arkadaşım çok teşekkür ediyorum zaman ayırdığın için.

Hemen bakıyorum

seenon72 · 10 Şubat 2010

Dosya EK'te

seenon72 · 10 Şubat 2010

İster TC numarası ister PBİK esas alınarak karşılaştırabilir,

bir de çıkanın yanında giren kişileri de yaparsanız çok memnun olurum.

Orion1 · 10 Şubat 2010

Dosyanızda G-H sütunu birleştirilmiş.ADO ve VBA birleştirilmiş hücreleri hiç sevmezler.Dosyanızda birleştirilmiş hücre kullanmayın.Düzenleyip tekrar ekleyin.

seenon72 · 10 Şubat 2010

Tekrar yükledim EK'te.

Orion1 · 10 Şubat 2010

Dosyanız ektedir.Girş ve çıkış kontrolü yapılıyorr.Verilerin çokluğuna göre her 2 kodda bilhassa giriş bölümü uzun süre çalışabilir.
Yalnız ben ocak dosyasındaki kenarlık biçimlendiröemlerini kaldırdım.
ADO bu yüzden veri olmayan hücreleride satırlarıda veri varmış gibi değerlendirdi.Ve gereksiz döngü oluştu.Buda programın çalışmasını yaavşlatır.Onun için sildim kenarlıkları.Sizde kaynak dosyanızdaki veri olmayan satırlardaki biçimlendirömeyi kaldırmayı unutmayınız.Kesinliklede birleştirilmiş hücre kullanmayınız.

Dosyanız ektedir.

Kod:

Sub cikanlar()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, j As Byte
Dim dosya, sat1 As Long, sat2 As Long, k As Range, sh As Worksheet
'vbe tools'tan reference'den microsoft activex dataobject 2.8 library seçildi.
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları," & _
        "*.xls", Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
If dosya = False Then
    MsgBox "Bir excel dosyası seçilmedi.İşlem yapılmadı.", vbCritical, "UYARI"
    Exit Sub
End If
Set sh = Sheets("GENEL")
sat1 = sh.Cells(65536, "C").End(xlUp).Row
sat2 = 2
Sheets("Çıkanlar").Select
Application.ScreenUpdating = False
Range("A2:IV65536").Clear
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & dosya & ";extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [GENEL$] order by ADISOYADI;", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then rs.MoveFirst
Do While Not rs.EOF
    Set k = sh.Range("F2:F" & sat1).Find(rs(5).Value, , xlValues, xlWhole)
    If k Is Nothing Then
        For j = 1 To rs.Fields.Count
            Cells(sat2, j).Value = rs(j - 1).Value
        Next
        sat2 = sat2 + 1
    End If
    rs.MoveNext
Loop
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Çıkanlar Listelendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"

End Sub
Sub girenler()
Dim conn As ADODB.Connection, rs As ADODB.Recordset, j As Byte
Dim dosya, sat1 As Long, sat2 As Long, k As Range, sh As Worksheet
'vbe tools'tan reference'den microsoft activex dataobject 2.8 library seçildi.
ChDir (ThisWorkbook.Path)
dosya = Application.GetOpenFilename(FileFilter:="Excel Dosyaları," & _
        "*.xls", Title:="Lütfen dosya seçimi yapınız") ' uzantı eklemeleri yapabilirsiniz
If dosya = False Then
    MsgBox "Bir excel dosyası seçilmedi.İşlem yapılmadı.", vbCritical, "UYARI"
    Exit Sub
End If
Set sh = Sheets("GENEL")
sat1 = sh.Cells(65536, "C").End(xlUp).Row
sat2 = 2
Sheets("Girenler").Select
Application.ScreenUpdating = False
Range("A2:IV65536").Clear
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & dosya & ";extended properties=""excel 8.0;hdr=yes"""
rs.Open "Select * from [GENEL$] order by ADISOYADI;", conn, adOpenKeyset, adLockReadOnly
If rs.RecordCount > 0 Then rs.MoveFirst
For d = 2 To sat1
    Do While Not rs.EOF
        If sh.Cells(d, "F").Value = rs(5).Value Then GoTo atla
        rs.MoveNext
    Loop
    For j = 1 To rs.Fields.Count
        Cells(sat2, j).Value = sh.Cells(d, j).Value
    Next
    sat2 = sat2 + 1
atla:
Next
rs.Close: conn.Close
Set rs = Nothing: Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Çıkanlar Listelendi." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub

seenon72 · 10 Şubat 2010

Ellerinize sağlık. Hemen inceliyorum

seenon72 · 10 Şubat 2010

Elinize sağlık.

Çıkanlarda sıkıntı yok doğru veriyor.

Ama girenlerde problem var sanırım. Çünkü daha önce bulunan personeli, sanki son ayda yeni girmiş gibi gösteriyor. (10 kişi ile yaptığım denemede bu sonucu verdi.)

Bir de personel sayısı artınca yani 1000 kişiyi geçince (sanırım bundan kaynaklı) sadece giren personel değil de o ay maaş yapılan tüm personeli listeliyor.

Bakabilmeniz mümkün müdür?

Orion1 · 10 Şubat 2010

seenon72' Alıntı:
Elinize sağlık.

Çıkanlarda sıkıntı yok doğru veriyor.

Ama girenlerde problem var sanırım. Çünkü daha önce bulunan personeli, sanki son ayda yeni girmiş gibi gösteriyor. (10 kişi ile yaptığım denemede bu sonucu verdi.)

Bir de personel sayısı artınca yani 1000 kişiyi geçince (sanırım bundan kaynaklı) sadece giren personel değil de o ay maaş yapılan tüm personeli listeliyor.

Bakabilmeniz mümkün müdür?

Dağa önce bulunan personel derken.
Seçtiğiniz dosyada bu personeller varmı yokmu.Kaynak dosyada ,veritabanında yoksa ve kodu çalıştırdığınız dosyada varsa bunu yeni girmiş gibi kabul ediyor.Ve öylede etmesi lazım.Çünkü onu karşışatrıyor.2 dosyada.Benim size yolladığım örnekte doğru çalışmıştı.1 personel bulmıuştu.Yani doğru çalışıyordu.10 personel ekleyip yollayın ve önceki dosyada olduğu halde bu dosyada yeni girmiş gibi değerlendirilenleri sarı boyayın.

seenon72 · 11 Şubat 2010

Şimdi Ocak ayında maaş alıp Şubat ayında ayrılan 1 personel var (mavi ile renklendirdiğim) çıkanı gösteriyor problem yok.

Şubat ayında ise kırmızı ile renklendirdiğim iki kişide problem yok ocak ayında da varlar.

Sarı ile renklendirdiğim kişiler ise ocak ayında da olmalarına rağmen girenler listesinde gösteriliyorlar. Renklendirmediklerim ise zaten maaşa yeni yani Şubat ayında dahil olanlar.

Orion1 · 11 Şubat 2010

seenon72' Alıntı:
Şimdi Ocak ayında maaş alıp Şubat ayında ayrılan 1 personel var (mavi ile renklendirdiğim) çıkanı gösteriyor problem yok.

Şubat ayında ise kırmızı ile renklendirdiğim iki kişide problem yok ocak ayında da varlar.

Sarı ile renklendirdiğim kişiler ise ocak ayında da olmalarına rağmen girenler listesinde gösteriliyorlar. Renklendirmediklerim ise zaten maaşa yeni yani Şubat ayında dahil olanlar.

Durumu düzelttim.4 numaralı mesajdan indirebilirsiniz.

Bu kodlarla giriş sayfası için yazılan kodların çalışması epey uzun sürüyor.Bu konuyu araştırıyorıum.Daha hızlı çalışacak kodlar bulduğumda bunlarla değiştiririz.
Şimdilik biraz yavaşta çalışsalar (giriş makrosu) işinizi doğru şekilde görürür.

seenon72 · 11 Şubat 2010

Çok teşekkür ederim emeğinize sağlık

Orion1 · 11 Şubat 2010

seenon72' Alıntı:
Çok teşekkür ederim emeğinize sağlık

Rica ederim.
İyi çalışmalar.

seenon72 · 11 Şubat 2010

Gerçekten süpersiniz.

Orion1 · 11 Şubat 2010

seenon72' Alıntı:
Gerçekten süpersiniz.

O sizin süperliğiniz.

İki ayrı excel belgesinde bulunan bilgileri karşılaştırarak farklı olanları listeleme

seenon72

seenon72

Ekli dosyalar

seenon72

Orion1

Uzman

Ekli dosyalar

seenon72

seenon72

Ekli dosyalar

seenon72

Orion1

Uzman

seenon72

Ekli dosyalar

Orion1

Uzman

Ekli dosyalar

seenon72

seenon72

Orion1

Uzman

seenon72

Ekli dosyalar

Orion1

Uzman

seenon72

Orion1

Uzman

seenon72

Orion1

Uzman