Soru Listedeki Eşsiz Kayıtların Yeni Bir Sütuna Kopyalanması

[ttb]

Merhaba, yardımcı olan arkadaşlarıma şimdiden teşekkür ederim.
Çalıştığım iş yerinde ufak harcamalar için proje bazında harcama belgesi (makbuz) düzenlenmekte ve her harcama belgesi için muhasebe tarafından bir kez sistemde kayıt oluşturulmakta. Sonrasında aynı proje için yapılacak harcamalar bu belge no (makbuz) altında kaydedilmekte.
Ancak sorun şu ki; çok fazla makbuz olduğu için, harcamaları yapan personel, o makbuz için daha önce muhasebede kayıt açılıp açılmadığını takip edemiyor. Muhasebedeki personel de kalem kalem harcamaları girdikten sonra, kayıtlı olmayan bir makbuz için giriş yaptıysa bunu son aşamada görebiliyor ve eksik makbuzun kaydını yaptıktan sonra tüm harcamalar için tekrar giriş yapması gerekiyor.
Harcama yapan personelin, düzenlediği harcama belgesini (makbuz) daha önce muhasebeye ibraz edip etmediğini takip edebilmesi için bir excel tablo hazırlamak istiyorum ama kendi başıma başaramadım.
Yapmak istediğimi ekli örnek tablo ile açıklamam gerekirse:

• Daha önce muhasebeye sunulmuş olan tüm makbuzlar, tabloda “tüm veri” sheetinde A sütununda kayıtlı olacak.
• Harcama yapan personel, “günlük veri” sheetinde A sütununa, o gün muhasebeye ileteceği harcamaların makbuz numaralarını yazacak,
• Girilen bu numaralardan, “tüm veri” sheetinde A sütununda kayıtlı olmayan varsa, (yani bu makbuz için daha önce kayıt oluşturulmadıysa) ilk kez kayıt edilecek bu numaralar günlük veri” sheetinde D sütununa otomatik kopyalanacak. Böylece personel, hangi makbuzlar için yeni kayıt açtırması gerektiğini görmüş olacak
• Ayrıca ilk kez girişi yapılan bu numaralar, “tüm veri” sheetinde A sütunun altına da otomatik eklenecek ki daha sonra aynı makbuz için tekrar harcama yapıldığında tekrar ilk kayıt gibi görünmesin.

Net anlaşılması için uzun bir şekilde yazdım, vaktinizi aldım, kusuruma bakmayın. Şimdiden teşekkür ederim.

 

[ÖmerBey]

Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.

Sub kod()
Dim G As Worksheet, T As Worksheet, a As Long
Set G = Sheets("Günlük Veri")
Set T = Sheets("Tüm Veri")
G.Range("D3:D1000").ClearContents
For a = 3 To G.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(T.Range("A:A"), G.Cells(a, "A")) = 0 Then
        G.Cells(Rows.Count, "D").End(3).Offset(1) = G.Cells(a, "A")
        T.Cells(Rows.Count, "A").End(3).Offset(1) = G.Cells(a, "A")
    End If
Next
MsgBox "Bitti"
End Sub

 

[ttb]

Merhaba,
Örnek dosyanız için aşağıdaki kodu deneyiniz.

Sub kod()
Dim G As Worksheet, T As Worksheet, a As Long
Set G = Sheets("Günlük Veri")
Set T = Sheets("Tüm Veri")
G.Range("D3:D1000").ClearContents
For a = 3 To G.Cells(Rows.Count, "A").End(3).Row
    If WorksheetFunction.CountIf(T.Range("A:A"), G.Cells(a, "A")) = 0 Then
        G.Cells(Rows.Count, "D").End(3).Offset(1) = G.Cells(a, "A")
        T.Cells(Rows.Count, "A").End(3).Offset(1) = G.Cells(a, "A")
    End If
Next
MsgBox "Bitti"
End Sub

Çok teşekkür ederim. Elinize sağlık.

 

[ÖmerBey]

Rica ederim,
İyi çalışmalar...