[Çözüldü] Girilen verilerin ekstresini alma işlemi

[Hüseyin Çoban]

Merhaba Arkadaşlar,

Borç-alacak takibi yapacak kadar, birazda kendimi geliştirmek için basit bir muhasebe takip tablosu yapmaya çalışıyorum.

Veri girişi sayfasında muhasebe kayıtlarını yapıyorum.
Ancak bu işlemlerin ekstresini alabilmem gerekiyor.

Ekstre sayfasında sarı ile belirttiğim hücrelere tarih ve listelenecek hesap kodunu girdiğimde,
11.satırdan itibaren veri girişi sayfasından girdiğim hesap kodunun olduğu satırları
Tarih ve Alacak TL arasına getirmeli.
Sıra no işlem sayısına göre yazmalı ve kayıtlar tarih sıralı olmalı.

Veri girişinden kayıtları 11. satır ile toplamlar satırı arasında olmalı. Yani 2 gri satır arasında olmalı.

Ekstre sayfasına örnek olması amacıyla kayıtların olması gerektiği gibi manuel giriş yaptım.

Yardım ve fikirlerinizi bekliyorum.

Dosya linktedir.
http://hotfile.com/dl/84595825/80b765a/MHSB10.rar.html

[Hüseyin Çoban]

Bu veya buna benzer bir işlem excelde yapılamaz mı.
Öyle ise tabloda değişikliğe gitmem gerekecek veya başka bir çözüm bulmalıyım.

[Bülent Öztürk]

Merhaba Hüseyin Bey,

Aslında yapılamaz diye pek fazla şey yok Excel'de, yeter ki mantık kurmaya uygun bir veri olsun.

Çok vaktim olmadı, biraz üzerinde çalıştım dosyanızın ve aşağıdaki gibi bir çözüme gittim.
Alttoplamlar için zamanım kalmadı, mesai bitti... Evde düzenleyebilirsem dosyanızı da eklerim...

İlgili arama hücrelerini: Tarih1, Tarih2 ve HesapSahibi olarak isimlendirdim.

Kod: [Seç]

Sub ExcelceRapor()
Dim excelce_kayit As Range
Dim say As Long, toplamlar As Long, kayit_satiri As Long, kayit_say As Long

For Each excelce_kayitsay In Worksheets("VERİ GİRİŞİ").Range("A6:A" & Worksheets("VERİ GİRİŞİ").Range("A65530").End(3).Row)
    If excelce_kayitsay.Offset(0, 1) >= Range("Tarih1") And excelce_kayitsay.Offset(0, 1) <= Range("Tarih2") And excelce_kayitsay.Offset(0, 5) = Range("HesapSahibi") Then
        kayit_say = kayit_say + 1
    End If
Next excelce_kayitsay

If kayit_say = 0 Then MsgBox "Uygun kayıt bulunamadı!", vbExclamation, "Tekrar deneyin!": Exit Sub

toplamlar = Worksheets("EKSTRE").Range("F12:H65530").Find("TOPLAMLAR   :", LookIn:=xlValues).Row - 1
Worksheets("EKSTRE").Range("A12:J" & toplamlar).ClearContents
bosluksay = toplamlar - 11
fark = bosluksay - kayit_say
If fark = 0 Then GoTo devam
If fark > 0 Then
    For sil = 1 To fark
        Worksheets("EKSTRE").Range("A13").EntireRow.Delete
    Next sil
End If
If fark < 0 Then
    For ekle = 1 To Abs(fark)
        Worksheets("EKSTRE").Rows("12:12").Select
        Selection.Copy
        Selection.Insert Shift:=xlDown
    Next ekle
End If

devam:
For Each excelce_kayit In Worksheets("VERİ GİRİŞİ").Range("A6:A" & Worksheets("VERİ GİRİŞİ").Range("A65530").End(3).Row)
    If excelce_kayit.Offset(0, 1) >= Range("Tarih1") And excelce_kayit.Offset(0, 1) <= Range("Tarih2") And excelce_kayit.Offset(0, 5) = Range("HesapSahibi") Then
        'MsgBox excelce_kayit.Offset(0, 5)
        say = say + 1
       
        kayit_satiri = Worksheets("EKSTRE").Range("A65530").End(3).Row + 1
        Worksheets("EKSTRE").Range("A" & kayit_satiri) = say
        Worksheets("EKSTRE").Range("B" & kayit_satiri) = excelce_kayit.Offset(0, 1)
        Worksheets("EKSTRE").Range("C" & kayit_satiri) = excelce_kayit.Offset(0, 2)
        Worksheets("EKSTRE").Range("D" & kayit_satiri) = excelce_kayit.Offset(0, 3)
        Worksheets("EKSTRE").Range("E" & kayit_satiri) = excelce_kayit.Offset(0, 4)
        Worksheets("EKSTRE").Range("F" & kayit_satiri) = excelce_kayit.Offset(0, 6)
        Worksheets("EKSTRE").Range("G" & kayit_satiri) = excelce_kayit.Offset(0, 7)
        Worksheets("EKSTRE").Range("H" & kayit_satiri) = excelce_kayit.Offset(0, 8)
        Worksheets("EKSTRE").Range("I" & kayit_satiri) = excelce_kayit.Offset(0, 9)
        Worksheets("EKSTRE").Range("J" & kayit_satiri) = excelce_kayit.Offset(0, 10)
    End If
Next excelce_kayit
MsgBox "Alttoplam formülleri düzenlenmeli...", vbInformation, "İşlem tamam."
End Sub



[Bülent Öztürk]

Hüseyin Bey, dosyanız ektedir.
Dener misiniz lütfen...



[Forum yazılım güncelleme esnasında sorun oluştuğundan eklendi silinmiştir.]

[Hüseyin Çoban]

Sy Bülent Hocam,

Çok teşekkür ederim. Excel böyle bir işlemi yapabilir mi diye düşündüğüm şeyi gerçekleştirmişsiniz.   

Tabiki bunun için özel bir emek ve zaman harcamışsınız. İlginiz ve yardımlarınız için ne kadar teşekkür etsem azdır.

 

[Bülent Öztürk]

Rica ederim Hüseyin Bey. Yardımcı olabildiysem ne mutlu. 

Kodları F8 ile adımlayıp işleyiş şeklini takip edebilirsiniz.

Not: Dosyanızda isimleri yazarken, yazılışlarının aynı olmasını sağlamak ve raporlamada sorun çıkmasını engellemek için, Veri Doğrulama Listesi oluşturup, oradan seçim yapmanızı tavsiye ederim.

Çalışmalarınızda başarılar.