• DİKKAT

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

Vba'da yıllık rapor almak

Katılım
5 Aralık 2007
Mesajlar
383
Excel Vers. ve Dili
EXCEL 2007
INGILIZCE
Arkadaşlar,
Dosyada açıklama yaptım.
Yardım ederseniz sevinirim.
Teşekkürler
 

Ekli dosyalar

Yıllık raporunuz hazır. :D :D :cool:
Kod:
Private Sub CommandButton1_Click()
Dim sh As Worksheet, z As Object, sat As Long, i As Long, myarr(), n As Long
ListBox1.Clear
Set sh = Sheets("kasagiris")
sat = sh.Cells(65536, "A").End(xlUp).Row
ReDim myarr(1 To 4, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 6 To sat
    If CInt(Month(sh.Cells(i, "A").Value)) <= Tarih.ListIndex + 1 Then
        If Not z.exists(sh.Cells(i, "B").Value) Then
            n = n + 1
            z.Add sh.Cells(i, "B").Value, n
        End If
        myarr(1, z.Item(sh.Cells(i, "B").Value)) = sh.Cells(i, "B").Value
        myarr(2, z.Item(sh.Cells(i, "B").Value)) = sh.Cells(i, "C").Value
        myarr(3, z.Item(sh.Cells(i, "B").Value)) = myarr(3, z.Item(sh.Cells(i, "B").Value)) + sh.Cells(i, "Q").Value
        myarr(4, z.Item(sh.Cells(i, "B").Value)) = myarr(4, z.Item(sh.Cells(i, "B").Value)) + sh.Cells(i, "R").Value
    End If
Next i

If n > 0 Then
    ReDim Preserve myarr(1 To 4, 1 To n)
    ListBox1.Column = myarr
End If
        
            
            
End Sub
 

Ekli dosyalar

vba

Evren hocam ellerinize sağlık ben eksik anlattım galiba istediğim gibi olmamış.

Örneğin,
Ocak - Şubat dediğimde mesela 398 plakalı aracın o aylar içinnde toplam hasılat ve tur sayısını görmek istedim.

Plaka Şoför Hasılat Tur sayısı
398 Serdar 364,45 24

gibi.

İlgilenirseniz çok sevinirim.

Teşekkürler
 

Ekli dosyalar

Evren hocam ellerinize sağlık ben eksik anlattım galiba istediğim gibi olmamış.

Örneğin,
Ocak - Şubat dediğimde mesela 398 plakalı aracın o aylar içinnde toplam hasılat ve tur sayısını görmek istedim.

Plaka Şoför Hasılat Tur sayısı
398 Serdar 364,45 24

gibi.

İlgilenirseniz çok sevinirim.

Teşekkürler

O zaman userforma bir tane combo koymanız lazımdı.Nerden bilecem ben.
Dosyayı ekledim.:cool:
 

Ekli dosyalar

VBA yıllık rapor

Evren hocam ben beceremiyorum anlatmayı kusura bakmayın
Dosyada userformun üstünde gösterdim.

Örneğin
01/01/2009 tarihinde 398 nolu plaka 191,50 tl hasılat getirip 12 tur atmış
01/02/2009 tarihinde 398 nolu plaka 195,15 tl hasılat getirip 12 tur atmış

Ocak - Şubat dediğimde

plaka şoför hasılat tur sayısı
398 serdar 386,65 24
..
..
..
yardım ederseniz sevinirim.
çok teşekkür ederim.
 

Ekli dosyalar

Bunu ilk mesajımda yazmıştım zaten.:cool:
 
Evren hocam,
ilk mesajdaki dosya denedim , toplamıyor
aynı plakayı diğer ayda varsa direk yazıyor
toplamadan.
Sizi fazla sıkmakta istemiyorum
ama bu raporda lazım.
tşk
 
Her plakayı ay ay toopalyıp listeliyor.
Dosya ektedir.:cool:
Kod:
Private Sub CommandButton1_Click()
Dim sh As Worksheet, z As Object, sat As Long, i As Long, myarr(), n As Long
ListBox1.Clear
Set sh = Sheets("kasagiris")
sat = sh.Cells(65536, "A").End(xlUp).Row
ReDim myarr(1 To 4, 1 To sat)
Set z = CreateObject("Scripting.Dictionary")
For i = 6 To sat
    If CInt(Month(sh.Cells(i, "A").Value)) <= Tarih.ListIndex + 1 Then
        If Not z.exists(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value) Then
            n = n + 1
            z.Add sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value, n
        End If
        myarr(1, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) = sh.Cells(i, "B").Value
        myarr(2, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) = sh.Cells(i, "C").Value
        myarr(3, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) = myarr(3, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) + sh.Cells(i, "Q").Value
        myarr(4, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) = myarr(4, z.Item(sh.Cells(i, "A").Value & "-" & sh.Cells(i, "B").Value)) + sh.Cells(i, "R").Value
    End If
Next i

If n > 0 Then
    ReDim Preserve myarr(1 To 4, 1 To n)
    ListBox1.Column = myarr
End If
        
            
            
End Sub
 

Ekli dosyalar

Geri
Üst