• DİKKAT

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

makro ile günlük aylık yıllık rapor nasıl alınır

Katılım
11 Ekim 2007
Mesajlar
62
Excel Vers. ve Dili
2010 TR
arkadaşlar makro ile günlük aylık ve yıllık rapor nasıl alınıyor kodlarda bana yardımcı olurmusunuz
yapmaya çalıştığım işlem ekte tarih seçtiğimde o tarihe ait olan
yıl olarak raporlama sayfasında o yıla ait olan dataların o güne kadar olan toplamı olacak örneğin sayaç 1 - 2010 yılı toplamı
(seçilen güne kadar )ay olarakta örneğin 8.ay (ağustos) sadece sectiğim tarihin ayının toplamı o güne kadar olanı
gün olarakta secilen günün dataları
kısaca bir tarih sectim diyelim 26.08.2010 bu güne kadar 2010 yılı toplamları ait olduğu ayın toplamı (ağustos) ve o günün toplamları
çok karışık oldu
teşekkürler
 

Ekli dosyalar

Son düzenleme:
Yetersiz açıklama yapmışsınız.
Yıl olarak hngi yılı arayacak.
Yılın toplamımı olacak.Yosa tek tek dökümümğ olacak.
Ayni konu ay içinde geçerli.
ay ise 2 ay arasımı olacak yoksa sadece bir aymı olacak.
Günde öyle.
Gördüğünüz gibi.Yardım istiyorsunuz ama yeterli açıklamayı yapmıyorsunuz.
Biz bunları nereden bilecez.
Bir şey yapıcaz yolayacaz sonra bu olmamış,Ben böyle istemiyordum diyeceksiniz.
Lütfen sorularınızı sorarken daha detaylı açıklamalar yapınız.
Nasıl ki sorunuzu cevaplayacak kişi üşenmeyip sorunuza yanıt veriyorsa sizde sorunuzu sorarken üşenmeyip daha detaylı açıklamalar yapmak durumundasınız.
Yoksa sorunuza herkes bakıp geçer yanıt vermez.
Bakmayın ben bunu yazdığıma .Bu ikazıda yazmayabilridim.
Şimdi ben bu açıklamayı yaparak sorunuza cevap verme hakkımı kullandım.
Eğer dediğim açıklamaları yapsaydınız Bu açıklam yerine sorunuza cevap vermiş olacaktım ve konu hallolacaktı.
Size kolay gelsin.:cool:
 
Selamlar,

Ekteki örnek dosyayı incelermisiniz. Filtreleme yöntemi kullanılmıştır.

Tarih seçin ve TEST isimli butona tıklayarak deneyin.

"DATA" isimli sayfanızda tarih sütunundaki bazı hücreler tarih olarak görünmemektedir. Hizalama yapılarak hepsi aynıymış gibi görüntü verilmiştir. Bunları düzeltmezseniz makro doğru sonucu vermez.

Ben bozuk olan tarihleri örnek dosyada elle düzelttim.

Kullanılan kod;
Kod:
Private Sub CommandButton2_Click()
    Dim S1 As Worksheet, S2 As Worksheet, X As Byte
    Dim Ayın_İlk_Günü As Date, Yılın_İlk_Günü As Date
    
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("RAPORLAMA")
    
    S2.Select
    
    If S2.Range("D4") = "" Then
        MsgBox "Lütfen tarih seçiniz !", vbCritical
        Range("D4").Select
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    S2.Range("D5:F38").ClearContents
    Range("E4") = Format(Range("D4"), "mmmm")
    Range("F4") = Format(Range("D4"), "yyyy")
    
    If S1.AutoFilterMode = False Then S1.Rows("2:2").AutoFilter
    S1.Range("$A$2:$IU$65536").AutoFilter Field:=1, Criteria1:=CDate(Range("D4"))
    S1.Calculate
    
    For X = 5 To Range("A65536").End(3).Row
        If S1.Cells(2, X - 2) = Cells(X, 2) Then
            Cells(X, 4) = S1.Cells(3, X - 2)
        End If
    Next
 
    If S1.AutoFilterMode = False Then S1.Rows("2:2").AutoFilter
    Ayın_İlk_Günü = DateSerial(Year(Range("D4")), Month(Range("D4")), 1)
    S1.Range("$A$2:$IU$65536").AutoFilter Field:=1, Criteria1:=">=" & CLng(Ayın_İlk_Günü), Operator:=xlAnd, Criteria2:="<=" & CLng(Range("D4"))
    S1.Calculate
 
    For X = 5 To Range("A65536").End(3).Row
        If S1.Cells(2, X - 2) = Cells(X, 2) Then
            Cells(X, 5) = S1.Cells(3, X - 2)
        End If
    Next
 
    If S1.AutoFilterMode = False Then S1.Rows("2:2").AutoFilter
    Yılın_İlk_Günü = DateSerial(Year(Range("D4")), 1, 1)
    S1.Range("$A$2:$IU$65536").AutoFilter Field:=1, Criteria1:=">=" & CLng(Yılın_İlk_Günü), Operator:=xlAnd, Criteria2:="<=" & CLng(Range("D4"))
    S1.Calculate
 
    For X = 5 To Range("A65536").End(3).Row
        If S1.Cells(2, X - 2) = Cells(X, 2) Then
            Cells(X, 6) = S1.Cells(3, X - 2)
        End If
    Next
 
    S1.Rows("2:2").AutoFilter
    
    Set S1 = Nothing
    Set S2 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub
 

Ekli dosyalar

Geri
Üst