• DİKKAT

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

Bir kitaptan 4 ayrı kitaba veri derleme

M

Mertsan

Katılım
12 Aralık 2015
Mesajlar
67
Excel Vers. ve Dili
Excel 2010 ingilizce
Merhaba Dostlar,

Excel de problemlern çözümünde mucizevi çözümler sunan VisualBasic kodlarıyla veri işleme
konusuna hayran kalmamak elde değil. Forumunuzda önemli konularda yardımınızı almaktan
ayrıca çok mutlu oldum. Yardımcı olan dostlara tekrar teşekkür ediyorum.

Bugün paylaşmak istediğim sorum bendenize çok daha komplike geldi. Tekrarlatılacak süreç belli,Sizler için kolay bir yolu olduğuna eminim,
sadece veri derleme hücreleri artarak ilerleyen düzende ve farklı kaynak ve hedef hücreler olduğundan anlatımı uzun sürdü.


Konu uzunluğu bakımından kusuruma bakmayınız. Ancak çözülebilirse çok büyük miktarda tuş vuruşu ve zaman kazancı olacak değerli bir çözüm olacaktır.

Konu bir çalışma kitabından veri derlemekle ilgili;
şöyle ki fisler adlı çalışma kitabında fişleri dökümünde alt alta sıralanmış
değişik türde muhasebe fişleri bulunmaktadır.


Derlenecek fisler kitabı ve kopyalanacak 4 adet aynı formattaki
kitapların bulunduğu dosya indirme linki:
https://yadi.sk/d/fGFGtn7RmYn8h


Fişler Bu haliyle yazıcıya arka arkaya yazdırmak için tasarlanmış. Bu nedenle
her bir fişin içinden derlemek istediğim veriler eşit oranda satır aralıklarıyla
sıralanmaktadır. Ancak derlenecek fiş başlıklarına göre 4 farklı çalışma kitabına
tarih sırasına göre kaydedilmesi gerekmektedir.


*Fişlerin içinden derlenecek verilere ait hücreleri sarı renk ile boyadım.
fişlere ve fişlerin kaydedileceği kitaplara bakılırsa derlenecek veriler daha kolay anlaşılabilir. (kitaplara birer satır örnek olarak doldurdum)

*ilk kopyalanacak hücreler E5,E6,M4,M6,L52 Hücrelerindedir. Bundan sonraki her fişteki kopyalanacak veriler bu hücrelerden itibaren aşağıya doğru 65'er satır sabit

artış ile uzanmaktadır.
*65 satır sonraki hücrelerdeki bilgiler de kopyalandıktan sonra tekrar bir 65 satır aşağıdaki hücreler şeklinde devam etmektedir.
*Kodlama ile sütundaki son değer de bulunduktan sonra işlem durmalıdır.




fisler adlı çalışma kitabında
E5 hücresindeki METİN DEĞERE göre 4 farklı çalışma kitabına Bu metin değer dahil sarı renk ile belirtilmiş hücreler tarih sırasına göre

(tarih değeri dahil) kopyalanacak, kopyalanacak bu değerlerin hepsini sarı renkli hücreler ile belirttim.

Kopyalanacak bütün hücreler 65 satırda bir yineleniyor. Bunu belirtmek ve daha iyi anlaşılmasını sağlamak için fişlerin en sağına 1 den 65 e kadar tekrarlayan sayaç

rakamları ekledim.


Veri derlemesi şu kurallara göre olacak.

Eğer E5 hücresindeki değer "Bankaya Girişler" veya "Bankadan Çıkışlar" veya "Ana hesap belgesi" veya "Satıcı Ödemesi" veya "Borç/Alacak Dekontu" ise Bu metin ve ilgili

değerler BANKA adlı çalışma kitabına yazdırılacak. Şöyle ki: Metin değer(örn: bankaya girişler) B96 hücresine ve sonrakiler aynı sütuna aşağı hücrelere doğru, bu

değerle ilgili olan E6 hücresindeki(METİN DEĞERİN HEMEN ALTINDAKİ) değer ise Yine BANKA KİTABINDAKİ Bordro nosu yazan Sütunun H96 hücresinden başlayarak aşağıya

doğru, M6 hücresindeki belge no karşısındaki değer ise BANKA Kitabındaki Belge No adlı sütunun altındaki E96 hücresine ve yine ilgili başlıklar olursa aynı satırın altına, M4 hücresindeki tarih yine BANKA KİTABINDAKİ belge tarihi adlı sütunun altındaki D96 hücresine ve ilgili diğer başlıklar altına sıralanacak, son olarak L52 sütununda bulunan tutar bilgisi BANKA KİTABINDAKİ belge tutarı adlı sütunun altındaki F96 hücresine yazdırılacak.

Yukarıda BANKA kitabına kaydedilecek başlıkların hepsi bu bahsedilen satırlara alt alta tarih sırasına göre kopyalanacak.

Diğer çalışma kitaplarına da benzer şekilde;

Eğer E5 "Çek/Senet Belgesi" veya "Müşteri çeki" ise ÇEK adlı çalışma kitabının B96 hücresine(özetle yine B,D,E,F,H Sütunlarındaki başlangıç yerlerine)

Eğer E5 "Satıcı faturası" ise FATURA adlı çalışma kitabına B96 hücresine(özetle yine B,D,E,F,H Sütunlarındaki başlangıç yerlerine)

Eğer E5 "Kasa Tahsil Belgesi" veya "Kasa Tediye Belgesi" ise KASA adlı çalışma kitabına (özetle yine B,D,E,F,H Sütunlarındaki başlangıç yerlerine)
kopyalanacak

Çözüm için çok arama yaptım ama benzer bazı kodları modifiye edebilecek yeterlilikte değilim.
Yardımlarınız için şimdiden teşekkür ederim.
Mert.
 
Merhaba.
Kitaplar arası veri aktarma işlemiyle hiç uğraşmadım ama şu şekilde öneride bulunayım.
fislistesi sayfasını BANKA adlı belgenize yeni bir sayfa olarak
(fissayfasi şeklindeki orijinal adıyla tabi) kopyaladıktan sonra
(iki belge de açıkken fisler belgesinde fissayfasi adına fareyle sağ tıklayıp,
Taşı veya Kopyala -> KOPYA OLUŞTUR'u işaretle, hedef kısmında da BANKA belgesini seç ve SONA TAŞI-> Tamam şeklinde yapabilirsiniz)
aşağıdaki kod ile istediğiniz veriler Sayfa1'de listelenecektir.

Benzer uygulamayı KASA ve diğer belgeler için de yapabilirsiniz sınırım.
Kod: 
[B]Sub BANKA_AKTAR_BRN()[/B]
Dim fis As Worksheet: Set fis = Sheets("[COLOR="Blue"]fissayfasi[/COLOR]")
Dim s1 As Worksheet: Set s1 = Sheets("[COLOR="blue"]Sayfa1[/COLOR]")
If s1.[B65536].End(3).Row = 95 Then GoTo 10
s1.Range("B96:H" & s1.[B65536].End(3).Row) = ""
10: sonfissatır = fis.[L65536].End(3).Row - 47
For satır = 5 To sonfissatır Step 65
    If fis.Cells(satır, 5) = "Bankaya Girişler" Or _
        fis.Cells(satır, 5) = "Bankadan Çıkışlar" Or _
        fis.Cells(satır, 5) = "Ana hesap belgesi" Or _
        fis.Cells(satır, 5) = "Satıcı Ödemesi" Or _
        fis.Cells(satır, 5) = "Borç/Alacak Dekontu" Then
        
        s1satır = s1.[B65536].End(3).Row + 1
        s1.Cells(s1satır, 2) = fis.Cells(satır, 5)
        s1.Cells(s1satır, 4) = fis.Cells(satır - 1, 13)
        s1.Cells(s1satır, 5) = fis.Cells(satır + 1, 13)
        s1.Cells(s1satır, 6) = fis.Cells(satır + 47, 12)
        s1.Cells(s1satır, 8) = fis.Cells(satır + 1, 5)
    End If
Next
MsgBox "Aktarma işlemi tamamlandı."
[B]End Sub[/B]
NOT:
BANKA için düzenlenmiş belge ekte.
 

Ekli dosyalar

Son düzenleme:
Sayın Ömer BARAN,
Çözüm öneriniz için çok teşekkür ederim.

Öncelikle test edip diğer sayfalara uyarlamaya çalışayım. Kodu uyarlayabilirsem iyi bir çıkış yolu olacak. Çalışmaya devam edeyim bakalım. Durumu bildireyim sizlere.

Tekrar teşekkürler.

Bu arada altın üyelik için ne yapmak gerekir? Genel bilgilerin olduğu bir link vardı ilk bakışta bulamadım sonradan.
 

Ekli dosyalar

Son düzenleme:
Merhaba Sayın Ömer BARAN

Öncelikle çözümünüz için çok teşekkür ederim.
Oldukça estetik güzel bir çalışma olmuş. Ellerinize sağlık.
Bu haliyle fişlerin dağılımı aynen istediğim gibi olmuş. Dediğiniz gibi sayfaları aynı çalışma kitabına taşıyarak rahatlıkla kullanılabilir. Çok elzem değil ama Belki başka çalışma kitaplarına dağıtım için kendim modifikasyon yapabilirim. Eğer zorlandığım yerler olursa bir iki küçük yardım daha gerekebilir.

Altın üyelik konusunu zaten düşünüyordum. Bu çözümünüzle birlikte daha önceki sorularımı da eklersek üç önemli problemime güzel çözümler buldum forumda. Diğer konularda yardımcı olan arkadaşlara da tekrar teşekkürler. Altın üyelikle birlikteki dosya ve kota avantajlarını da düşünürsek hem paylaşımda yarar sağlar hem de sitenin hizmetlerini sürdürmesinde iyi olur elbette.

Bu vesileyle Altın üyelik başvurumu yaptım
Sipariş #84958 numarasıyla kayıtlıdır. Üyeliğin aktifleşmesi için ayrıca birşey yapmak gerekiyor mu acaba?

İyi çalışmalar dilerim.
Mertsan.
 
Aşağısaki metin ALTIN ÜYELİK sayfasından alıntıdır.
Altın Üyelik aktivasyonları Mesai saatleri içinde yapılmaktadır. Mesai saatleri dışında admin@excel.web.tr adresine email ile bilgi vermeniz halinde aktivasyonunuz yapılır.
 
Yanıtınız için teşekkür ederim Sayın Ömer Baran bey,

Altın üyeliğim aktifleştirilmiş..
Önceki mesajımda zaten üye olmayı düşündüğümü yazmıştım. Ancak bilmelisiniz ki son gönderdiğim fişlerden veri derleme çözümünüzle birlikte kesin karar verdim. Böyle komplike çalışmalara zaman ayırmanız, emek vermeniz hem foruma değer veriyor hem de karşılığını vermeyi hak ediyor.

Ek not olarak Türkçe ile ilgili imzanız takdire değer.

Tekrar teşekkürler, iyi çalışmalar.
 
İhtiyaç grüldüğüne/amaç hasıl olduğuna göre mesele yok.
İyi günler dilerim.
 
Tekrar Merhaba Dostlar,

Sayın Ömer BARAN bey'in tasarladığı çözüm kodları ile epeyce testler yaptım. Fiş gönderen mekanizmada yeni bir durum oluştu. Şöyle ki;
Fişlerimin için "Ana hesap belgesi" türünden fişler ile bazı "Çek/Senet Belgesi" türünden fişlerin referans numarasının aynı olduğunu farkettim. Böyle bir durumda referans numarası aynı olan bu iki tür belge olduğunda "Ana hesap belgesi" aynı vba kodunun belirlediği BANKA hedef sayfasına yazdırılacak, ancak "Çek/Senet Belgesi" ÇEK sayfasına yazdırılmayacak. Bu haliyle kodlamadan önce öyle istediğim için ÇEK sayfasına yazdırılıyor. Önce böyle bir kriter yoktu. Eke böyle iki fişin daha eklendiği aynı örnek dosyayı tekrar yükledim. Resim de de belirtmeye çalıştım.

Böyle bir filtre olacak koşullu bir kod eklemeyi başaramadım.
Yardımcı olursanız sevinirim.
 
Arkadaşlar bu belirttiğim problemi farklı bir mantıkla çözdüm.
Çözümü bulduktan sonra forumda da yararlı olması için ilgili kodu aşağıda veriyorum.

Kodların başlangıç tasarımı sayın Ömer BARAN bey'e aittir. Bu vesileyle kendisine tekrar teşekkür ederim.

H sütunundaki Aynı referans numarasına sahip satırları(kriter H sütunu) hem BANKA sayfasında hem ÇEK sayfasında aynı sütunda arayıp karşılaştırıyoruz ve iki sayfada da aynı referansları bulursa sadece ÇEK sayfasındaki mükerrer kayıtların olduğu satırları temizliyor. Bu kodu başka bir siteden buldum.
Böylece ayırımı aktarım sırasında değil aktarım yaptıktan sonra yapmış oluyoruz. Aktarım sırasında bir karar kodu ekleyebilmek isterdim. Ancak şimdilik bu yeterlilikte değilim.

Sonraki aşamada satırları yeniden sıralayan bir kod ekledim. Böylece ÇEK sayfasınadaki(ve diğer sayfalardakiler de) fiş bilgileri alfabetik olarak yeniden düzene giriyor. Bu kodu kendim uyarladım.

Yararlı olması dileği ile.

Kod: 
Sub BANKA_AKTAR_BRN()
Dim fis As Worksheet: Set fis = Sheets("fissayfasi")
Dim s1 As Worksheet: Set s1 = Sheets("BANKA")
Dim s2 As Worksheet: Set s2 = Sheets("KASA")
Dim s3 As Worksheet: Set s3 = Sheets("FATURA")
Dim s4 As Worksheet: Set s4 = Sheets("ÇEK")

    s1.Range("B96:H" & s1.[B65536].End(3).Row) = ""
    s1.Cells(95, 2) = "Fiş Türü": s1.Cells(95, 4) = "Tarih": s1.Cells(95, 5) = "Belge No"
    s1.Cells(95, 6) = "Tutar": s1.Cells(95, 8) = "Referans"
    
    s2.Range("B96:H" & s2.[B65536].End(3).Row) = ""
    s2.Cells(95, 2) = "Fiş Türü": s2.Cells(95, 4) = "Tarih": s2.Cells(95, 5) = "Belge No"
    s2.Cells(95, 6) = "Tutar": s2.Cells(95, 8) = "Referans"
    
    s3.Range("B96:H" & s3.[B65536].End(3).Row) = ""
    s3.Cells(95, 2) = "Fiş Türü": s3.Cells(95, 4) = "Tarih": s3.Cells(95, 5) = "Belge No"
    s3.Cells(95, 6) = "Tutar": s3.Cells(95, 8) = "Referans"
    
    s4.Range("B96:H" & s4.[B65536].End(3).Row) = ""
    s4.Cells(95, 2) = "Fiş Türü": s4.Cells(95, 4) = "Tarih": s4.Cells(95, 5) = "Belge No"
    s4.Cells(95, 6) = "Tutar": s4.Cells(95, 8) = "Referans"

sonfissatır = fis.[L65536].End(3).Row - 47

For satır = 5 To sonfissatır Step 65
    If fis.Cells(satır, 5) = "Bankaya Girişler" Or _
        fis.Cells(satır, 5) = "Bankadan Çıkışlar" Or _
        fis.Cells(satır, 5) = "Ana hesap belgesi" Or _
        fis.Cells(satır, 5) = "Satıcı ödemesi" Or _
        fis.Cells(satır, 5) = "Borç/Alacak Dekontu" Then
    Set hedef = s1
    ElseIf fis.Cells(satır, 5) = "Kasa Tahsil Belgesi" Or _
        fis.Cells(satır, 5) = "Kasa Tediye Belgesi" Then
    Set hedef = s2
    ElseIf fis.Cells(satır, 5) = "Satıcı faturası" Then
    Set hedef = s3
    ElseIf fis.Cells(satır, 5) = "Çek/Senet Belgesi" Or _
        fis.Cells(satır, 5) = "Müşteri çeki" Then
    Set hedef = s4
    End If
            hedefsatır = hedef.[B65536].End(3).Row + 1
            hedef.Cells(hedefsatır, 2) = fis.Cells(satır, 5)
            hedef.Cells(hedefsatır, 4) = fis.Cells(satır - 1, 13)
            hedef.Cells(hedefsatır, 5) = fis.Cells(satır + 1, 13)
            hedef.Cells(hedefsatır, 6) = fis.Cells(satır + 47, 12)
            hedef.Cells(hedefsatır, 8) = fis.Cells(satır + 1, 5)
            
Next
  
'Buradan itibaren çek sayfasındaki referans sütunundaki banka sayfasındakilerle mükerrerer olan referanslı satırlar tespit edilip siliniyor.

Dim ana As Worksheet, test As Worksheet, c As Worksheet
Dim i As Long, a As Long, z As Long, x As Long, y1 As String, y2 As String

    Set ana = Sheets("BANKA")
    Set test = Sheets("ÇEK")
    
    
    a = ana.Range("h65536").End(3).Row
    z = test.Range("h65536").End(3).Row
    y1 = Mid(ana.Range("IV1").End(1).Address, 2, InStrRev( _
                 ana.Range("IV1").End(1).Address, "$", -1, 1) - 2)
    y2 = Mid(test.Range("IV1").End(1).Address, 2, InStrRev( _
                 test.Range("IV1").End(1).Address, "$", -1, 1) - 2)
    
    For i = 2 To a
        For x = 2 To z
            If ana.Cells(i, 8).Value = test.Cells(x, 8).Value Then
               test.Rows(x).ClearContents
            End If
        Next x
    Next i

       
Set c = Nothing: Set ana = Nothing: Set test = Nothing
        i = Empty: a = Empty: z = Empty: x = Empty
            y1 = vbnulstring: y2 = vbNullString
        


    
   'Buradan itibaren sıralama işlemi yaptırıyoruz.
   
Dim EVRAK(4) As String

EVRAK(0) = "BANKA"
EVRAK(1) = "KASA"
EVRAK(2) = "FATURA"
EVRAK(3) = "ÇEK"

For i = 0 To 3
    Worksheets(EVRAK(i)).Activate
    Worksheets(EVRAK(i)).Range("B96:H183").Select
    Selection.Sort Key1:=Range("D:D"), _
    Order1:=xlAscending, Header:=xlGuess, _
    Orientation:=xlTopToBottom
Next
   
MsgBox "Aktarma işlemi tamamlandı ve sıralandı."
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst