• DİKKAT

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

kredi kartı slipleri takip

A

aptillah

Katılım
24 Ocak 2010
Mesajlar
138
Excel Vers. ve Dili
2010 türkçe
merhabalar altın üyeliğim olmadığı için dosyayı ekleyemedim.. soruma geçicek olursam..1 nisandan başlayıp 30 nisana kadar olan bi çalışma kitabım var her gün için ayrı sayfa burada yapmak istediğim hangi gün kaç tane slip çekildiyse bunu "slip" adlı sayfaya listelemek örnek

a b c
tarih
01.04.2014
02.04.2014

b sütunundan başlayarak kaç tane çekim yapılmışsa yan yana sıralayacak ... kod yada formül hangisi olursa yardımlarınızı bekliyorum
 
Merhaba,
Eğer örnek dosyanız olursa daha hızlı ve daha doğru yardımlar alırsınız.
Herhangi bir dosya paylaşım sitesine dosyanızı yükleyip link vererek dosya paylaşımı yapabilirsiniz.
 
Aşağıdaki kodu dener misiniz?
Kod: 
Sub Aktar()
Set s = Sheets("SLİP")
s.Range("C:ZZ").ClearContents
For a = 2 To s.[A65500].End(3).Row Step 2
    tarih = s.Cells(a, 1)
    If tarih <> "" Then
    For Each sayfa In Worksheets
        If sayfa.Range("A1").Value = tarih Then
            sat = a + 1
            For b = 6 To 7
                For c = 6 To 51
                    If sayfa.Cells(c, b) <> "" Then
                        süt = Range("ZZ" & sat).End(xlToLeft).Column + 1
                        s.Cells(sat, süt) = sayfa.Cells(c, b)
                    End If
                Next c
                sat = sat - 1
            Next b
            GoTo sonra:
        End If
    Next
    End If
sonra:
Next a
End Sub
 
saolun hocam elinize sağlık bi kaç sorum daha olacak sliplerin enounlarınada bir boşluk bırakıp toplamları alınabilirmi gün gün bide ben bu makronun slip dosyası açıldığında çalışmasını istiyorum
 
SLİP sayfasının kod bölümüne yapıştırınız.
Kod: 
Private Sub Worksheet_Activate()
Set s = Sheets("SLİP")
s.Range("C:ZZ").ClearContents
For a = 2 To s.[A65500].End(3).Row Step 2
    tarih = s.Cells(a, 1)
    If tarih <> "" Then
    For Each sayfa In Worksheets
        If sayfa.Range("A1").Value = tarih Then
            sat = a + 1
            For b = 6 To 7
                For c = 6 To 51
                    If sayfa.Cells(c, b) <> "" Then
                        süt = s.Range("ZZ" & sat).End(xlToLeft).Column + 1
                        s.Cells(sat, süt) = sayfa.Cells(c, b)
                    End If
                Next c
                sat = sat - 1
            Next b
            GoTo sonra:
        End If
    Next
    End If
sonra:
    sontl = s.Range("ZZ" & a).End(xlToLeft).Column
    soneu = s.Range("ZZ" & a + 1).End(xlToLeft).Column
    Cells(a, sontl + 2) = WorksheetFunction.Sum(Range(Cells(a, "C"), Cells(a, sontl)))
    Cells(a + 1, soneu + 2) = WorksheetFunction.Sum(Range(Cells(a + 1, "C"), Cells(a [COLOR="Red"]+ 1[/COLOR], soneu)))
Next a
End Sub
 
Son düzenleme:
05.04.2014 TL 100 250 350
EURO 150 150 20 670

hocam çok saolun ama şöle bi problem var euro kısmı toplanırken üst satırıda topluyor
 
Gözden kaçmış, farkedememişim.
Yukarıda 6. mesajdaki kodu düzenledim, kırmızı renkli kısmı siz de kodunuzda değiştiriniz.
 
saolun hocam elinize sağlık çok oldum isteklerimler ama bi kaç şey daha ekleyebilirmiyiz ? toplamları 2 kare yanına alıyor ya aynı hizada almak istedimde yapamadım yani en uzun satıra göre toplamları aynı hizada alsın ve toplamlar oldugu kare sarı renkte olsunson olarakta kenarlıkları ona göre çizsin tekrar sizi yordugum için özür dilerim
 
Son düzenleme:
Deneyin...
Kod: 
Sub Aktar()
Set s = Sheets("SLİP")
s.Range("C:ZZ").ClearContents
s.Range("C:ZZ").Interior.ColorIndex = 0
For a = 2 To s.[A65500].End(3).Row Step 2
    tarih = s.Cells(a, 1)
    If tarih <> "" Then
    For Each sayfa In Worksheets
        If sayfa.Range("A1").Value = tarih Then
            sat = a + 1
            For b = 6 To 7
                For c = 6 To 51
                    If sayfa.Cells(c, b) <> "" Then
                        süt = Range("ZZ" & sat).End(xlToLeft).Column + 1
                        s.Cells(sat, süt) = sayfa.Cells(c, b)
                        If süt > son Then son = süt
                    End If
                Next c
                sat = sat - 1
            Next b
            GoTo sonra:
        End If
    Next
    End If
sonra:
Next a

For i = 2 To s.[A65500].End(3).Row
    s.Cells(i, son + 2) = WorksheetFunction.Sum(Range(Cells(i, 3), Cells(i, son)))
    s.Cells(i, son + 2).Interior.ColorIndex = 6
Next
End Sub
 
Siz de sağolun,
İyi çalışmalar...
 
hocam sizi gene rahatsız ediyorum ama tl ve euro toplamları slip dosyasında a1 ve b1 e yazdırabilirmiyiz
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst