• DİKKAT

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

Kasa çizelgesinde Özet tablolar sonuçlar

  • Konbuyu başlatan Konbuyu başlatan modoste
  • Başlangıç tarihi Başlangıç tarihi
M

modoste

Altın Üye
Katılım
31 Mayıs 2008
Mesajlar
3,714
Excel Vers. ve Dili
Microsoft OFFİCE Ev ve İş 2019 TR
merhaba sayın hocalarım
2009 yılında yine buna benzer bir kasa sorusu sormuştum ve hocalarım çok kullanışlı bir çözüm hazırlamışlardı bana hocalarımdan isim veremesemde kendisi bilir çok teşekkür ederim.
o sorumda sadece altalta verilerin yazıldığı bir çizelgeden yola çıkarak
tarih-kod-açıklama-gelir-gider başlıklarından oluşan ve tarihlerin sırasının bile önemli olmadığı verileri
belirli tarihler arasında belirli bir kod seçilince verileri başka biryere sıralıyodu..

şimdiki soracağım tablom ise ay ay tutulmuş olan bir çizelge (1-2-3....) ben sorumda 2 aydan ibaret tutacağım sekme adları (1-2) olcak
her ayın çizelge şablonu aynı yani sütunlardaki başlıklar vs aynı kalıyo hiç ötelenme kayma yok yıl sonuna kadar böyle tutulcak
yalnızca ben A sütununa tarihleri tarih formatında birkez daha yazdırdım A sütunu boş idi istediğim sonuca ulaşılması açısından gerekli olabilir diye düşündüm.

istediğim ise 1-2 sekmelerindeki doldurulmuş verilere göre bu daha sonra diğer aylarıda kapsayacak tabiikide Sonuçlar sekmesinde başlangıç tarihini G1, bitiş tarihini H1 hücrelerine yazarak , işlem kodu nu da I1 e yazarak belirlediğim kriterlere göre verileri sıralamak.

not : ekli çizelgede 1 ve 2 sekmelerinde D sütununda olan İşlen KOD u sütununa veri doldurulmamıştır. ama daha sonra doldurulcaktır ben formülasyonu bu kritere göre yaptırmak istiyorum.
çözümler makro da olabilir formüllüde
 

Ekli dosyalar

Son düzenleme:
Merhaba,

Daha öncede size söylemiştim. Çoklu sayfalarda toplama yapabilirisiniz fakat veri çekme işlemi çok daha karışıktır. Bu yüzden veri çekme işlemini makro ile yapmanızı tavsiye ederim.
Eğer makro işinizi görür ise hazırlayıp ekleyeyim.

Not: Özel mesaj kutunuzu sınırda bırakmamaya özen gösteriniz. 10 dan fazla saklama olmadığı için mesaj alımlarda sorun yaşarsınız.

.
 
sayın ömer hocam makro ile olabilir evet bunu söylediniz biliyorum
bu sorumu sorarken makro ile olabilir diye yazmıştım çözümünüzü beklemekteyim
 
Module kopyalarak çalıştırınız.

Kod: 
Sub SayfalardanAktar()

Dim i As Integer, sat As Long, j As Long
 
Application.ScreenUpdating = False

Sheets("Sonuçlar").Select
Range("C4:H" & Rows.Count).ClearContents

sat = 4
For i = 1 To Worksheets.Count
    With Sheets(i)
        If .Name <> "Sonuçlar" Then
            For j = 5 To .Cells(Rows.Count, "A").End(xlUp).Row
                If .Cells(j, "A") >= [G1] And .Cells(j, "A") <= [H1] _
                And .Cells(j, "D") = [I1] Then
                    .Range("C" & j & ":H" & j).Copy
                    Range("C" & sat).PasteSpecial xlPasteValues, xlNone
                    sat = sat + 1
                End If
            Next j
        End If
    End With
Next i

Application.CutCopyMode = False: [C4].Select
Application.ScreenUpdating = True

End Sub
.
 
şimdi uyguluyorum hocam sonuçlarını görünce foruma ve size dönücem
sayın hocam uygulamaları yaptım çeşitli birkaç alternatif yaptım düzenli bir şekilde altalta sıralıyo

peki hocam ben sorumu sorarken sonuç alacağım çizelgede tarihsel bi alan unutmuşum
Sonuçlar sekmesinde A sütunuda da ilgili tarihleri yazdırabilirmiyiz. (az önce B sütunu diye yazmıştım)

siz B sütununa yeni kod u yazmadan ben hemen düzelteyim dedim
A sütünuna ilgili tarihleri yazdırsak
ki bende her sekmede A sütununa tarihleri yazmıştım.
 
Son düzenleme:
Kodları aynı module kopyalarak;

SonuclarıYazdır

Kodunu butona bağlayarak çalıştırınız.

Kod: 
[COLOR=darkgreen]' Tarihleri icmallere aktaran kodlar[/COLOR]
Sub TarihVer(kod1 As String)
 
Dim c As Range, ilkadres As Variant, fark As Integer, i As Integer
 
Application.ScreenUpdating = False
 
For i = 1 To Worksheets.Count
    With Sheets(i)
        If .Name <> "Sonuçlar" Then
            .Range("A:A").ClearContents
            Set c = .Range("B:B").Find(1, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                ilkadres = c.Address
                Do
                    If c.Row = 5 Then
                        fark = 4
                    Else
                        fark = 3
                    End If
 
                    son = .Range("B" & c.Row).End(xlDown).Row
                     .Range("A" & c.Row & ":A" & son) = _
                        .Range("H" & c.Row - fark)
 
                    Set c = .Range("B:B").FindNext(c)
                Loop While Not c Is Nothing And c.Address <> ilkadres
            End If
        End If
    End With
Next i
 
Application.ScreenUpdating = True
 
End Sub
 
[COLOR=darkgreen]' Ölçüte göre sayfalardan veri alan kodlar[/COLOR]
Sub SayfalardanAktar(kod2 As String)
 
Dim i As Integer, sat As Long, j As Long
 
Application.ScreenUpdating = False
 
Sheets("Sonuçlar").Select
Range("C4:H" & Rows.Count).ClearContents
sat = 4
For i = 1 To Worksheets.Count
    With Sheets(i)
        If .Name <> "Sonuçlar" Then
            For j = 5 To .Cells(Rows.Count, "A").End(xlUp).Row
                If .Cells(j, "A") >= [G1] And .Cells(j, "A") <= [H1] _
                And .Cells(j, "D") = [I1] Then
                    .Range("C" & j & ":H" & j).Copy
                    Range("C" & sat).PasteSpecial xlPasteValues, xlNone
                    sat = sat + 1
                End If
            Next j
        End If
    End With
Next i
 
Application.CutCopyMode = False: [C4].Select
Application.ScreenUpdating = True
 
End Sub
 
[COLOR=darkgreen]'İki kodu birleştiren yordam[/COLOR]
[COLOR=blue]Sub SonuclarıYazdır()[/COLOR]
    
    TarihVer "kod1"
    SayfalardanAktar "kod2"
 
[COLOR=blue]End Sub[/COLOR]


.
 
sayın ömer hocam ilk kod u modüle kopyalayıp kullanmıştım ama bu dediğinizi anlayamadım
yine yeni bi modüle yapıştırdım ama aynı sonucu verdi biryerde hata yaptım
siz acaba ekli dosya ile sonuçlayabilirmisiniz.
 
Eski kodları silin, sadece son eklediğim kodları kopyalayın.

.
 
sayın hocam dediklerinizi yapıyorum.
fakat makronun sonucu yine bir önceki gibi çıkıyo yani Sonuçlar sekmesinde A sütununda tarihler görünmüyo
 
Butonu "SonuclarıYazdır" bu kodlara bağlayınız.

Yine olmazsa uyguladığınız dosyayı ekleyin.

.
 
modoste' Alıntı:
sayın hocam dediklerinizi yapıyorum.
fakat makronun sonucu yine bir önceki gibi çıkıyo yani Sonuçlar sekmesinde A sütununda tarihler görünmüyo
Genişletmek için tıkla ...

Sizin amaçınız neydi?

Sonuçlar sekmesin de tarih sütunu yok ki.

.
 
Sayın Ömer Hocam özür dilerim.
makrolarla ilgili bildiğim dosya açıkken ALT+F11 ile İNSERT / MODULE diyip verdiği kodu yapıştırıp. sonra dosyayı açınca ALT+F8 ile açılan yerden makroyu seçip çalıştır demek

Butonu "SonuclarıYazdır" bu kodlara bağlayınız bu tip komutları bilmediğimden çaresiz kaldım.

hocam bu mesajı yazınca sizin mesaj geldi
benim istediğim her sekmedeki A sütununda yazdığım tarihleri de makro uyguladıktan sonra yine A sütunundada görmek ti.
 

Ekli dosyalar

Eklediğiniz dosyada tarih sütunu yok.

Lütfen sorularınızın dosya ile uyuşmasına özen gösteriniz.
 
sayın hocam anlam kargaşasına yol açtıysam özür dilerim
metinsel bi ifade ile şunu yazmaya çalışmıştım
1 ve 2 sekmelerinde A sütunlarındaki yazılan tarihleri, sizin ilk makro çözümünüzde yine A sütununda da görebilirmiyim.
bu yapıldıktan sonra en son kasa raporu isteğimi hatasız anlatmaya çalışcam
 
Ekledim.

Yalnız #5 nolu mesajınızda konuyu tam olarak aktarmadığınız için ben sayfalar da (1-2 diye adlandırdığınız sayfalar da ) A sütununa elle yazdığınız tarihleri kodla yazılması için kod yazmıştım.

.

Kod: 
' Tarihleri icmallere aktaran kodlar
Sub TarihVer(kod1 As String)
 
Dim c As Range, ilkadres As Variant, fark As Integer, i As Integer
 
Application.ScreenUpdating = False
 
For i = 1 To Worksheets.Count
    With Sheets(i)
        If .Name <> "Sonuçlar" Then
            .Range("A:A").ClearContents
            Set c = .Range("B:B").Find(1, LookIn:=xlValues, LookAt:=xlWhole)
            If Not c Is Nothing Then
                ilkadres = c.Address
                Do
                    If c.Row = 5 Then
                        fark = 4
                    Else
                        fark = 3
                    End If
 
                    son = .Range("B" & c.Row).End(xlDown).Row
                     .Range("A" & c.Row & ":A" & son) = _
                        .Range("H" & c.Row - fark)
 
                    Set c = .Range("B:B").FindNext(c)
                Loop While Not c Is Nothing And c.Address <> ilkadres
            End If
        End If
    End With
Next i
 
Application.ScreenUpdating = True
 
End Sub
 
' Ölçüte göre sayfalardan veri alan kodlar
Sub SayfalardanAktar(kod2 As String)
 
Dim i As Integer, sat As Long, j As Long
 
Application.ScreenUpdating = False
 
Sheets("Sonuçlar").Select
Range("A4:A" & Rows.Count).ClearContents
Range("C4:H" & Rows.Count).ClearContents
sat = 4
For i = 1 To Worksheets.Count
    With Sheets(i)
        If .Name <> "Sonuçlar" Then
            For j = 5 To .Cells(Rows.Count, "A").End(xlUp).Row
                If .Cells(j, "A") >= [G1] And .Cells(j, "A") <= [H1] _
                And .Cells(j, "D") = [I1] Then
                    .Range("C" & j & ":H" & j).Copy
                    Range("C" & sat).PasteSpecial xlPasteValues, xlNone
                    Range("A" & sat) = .Range("A" & j)
                    sat = sat + 1
                End If
            Next j
        End If
    End With
Next i
 
Application.CutCopyMode = False: [C4].Select
Application.ScreenUpdating = True
 
End Sub
 
'İki kodu birleştiren yordam
Sub SonuclarıYazdır()
 
    TarihVer "kod1"
    SayfalardanAktar "kod2"
 
End Sub
 
Son düzenleme:
ömer hocam anlayamadım gitti yaptıklarınız ben bir türlü uyarlayamıyorum hocam
şu son yazdığınız modulü kopyalıyorum hata veriyo bu seferde

hocam ben herşeyi en baştan sormak istiyorum
1. sorumda ilk gönderdiğim ekli çizelgeme göre belirli tarihler ve belirli bir koda göre kasanın özeti gibi verilerin altalta dizilmesini Sonuçlar sekmesinde yapmaktı.
makroyu denedim sonuç kusursuz çıktı.
2. sorumda ise isteğim şuydu sonuçlar sekmesinde A sütunundaki boş alana 1-2 sekmelerinin A sütunlarına benim manuel yazdığım tarihleride göstersin. ben burada dağıldım eklediğiniz makroları uygulayamadım bilmediğimden hatalar mı yaptım ama yok yapamadım işte
2. sorum için ekli dosya eklermisiniz.
 
İlk eklediğiniz tabloya kodu uygulayıp kodu çalıştırın. Hata veriyorsa, o haliyele ekleyin.

.
 
evet hocam bu sefer istediğim sonuç çıktı
ben şöyle yapıyodum ilk makrolu dosyamda kopya alıyodum ALT+F8 de açılan ekrandan makroyu siliyodum makrosuz ilk dosya eklediğim halde gibidir diye düşünüp diğer kodu yeniden ekliyodum.
bu hatamı hocam
 
Eski kodları normal silip yapmanız gerekiyor du.

Olduğuna sevindim. Ayrıca bu kodlarla sayfalara manuel tarih girmenizede gerek kalmaz.

İyi çalışmalar..

.
 
Evet hocam sayfaların sonlarındaki benim manuel yazdıklarımı silerek tekrar makro çalıştırdım.
çok kullanışlı çözüm oldu.
makro ile çözüm aldıktan sonra karşıma çıkan veri kümesinden fonksiyonalarla değişik sonuçlara da ulaşılabilicek gibi.
tekrar teşekkürler sizi yordum bugün.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst