sayfalardaki verileri raporlama

[leumruk]

Merhaba,
Dosyanız ekte.

 

[vol1980]

Hocam kusura bakmayın.Eğer sende çok oluyosun demezseniz ekteki dosyayı bir incelemenizi rica ediyorum.Üzerinde çalıştığımız dosyanın formatında bir değişiklik olmuş.Ben manuel olarak bir veri sayfası hazırladım.Altına da gerekli açıklamaları yaptım.İncelemenizi rica ediyorum.

 

[leumruk]

Hocam kusura bakmayın.Eğer sende çok oluyosun demezseniz ekteki dosyayı bir incelemenizi rica ediyorum.Üzerinde çalıştığımız dosyanın formatında bir değişiklik olmuş.Ben manuel olarak bir veri sayfası hazırladım.Altına da gerekli açıklamaları yaptım.İncelemenizi rica ediyorum.

21 nolu mesajdaki dosyayı güncelledim. Birleştirilmiş hücrelerden dolayı sıralama makrosunu kullanamadım. Eğer birleştirilmiş hücreleri tek hücreye düşürürseniz sıralamayı da ekleyebiliriz.

 

[vol1980]

Hocam dosyada satır ve sütunları sadeleştirdim.Şimdi yakıt cinsine göre ayırıp tarih sırasına dizecek bir kod yazar mısınz?
teşekkür ederim.

 

[leumruk]

Merhaba,

Sub Bul_Aktar()
Set Asy = Sheets("Ana Sayfa")
For Syf = 2 To Sheets.Count
Set s = Sheets(Sheets(Syf).Name)
If WorksheetFunction.CountA(s.[k2:k65536]) > 0 Then
s.Range("a2:I65536") = ""
Sat = 2
Set Aralik = Asy.Range("d2:d" & Asy.[d65536].End(3).Row)
Application.ScreenUpdating = False
For x = 2 To s.[k65536].End(3).Row
İlk = Sat
    Set Bul = Aralik.Find(s.Cells(x, "k"), LookIn:=xlValues, LookAt:=xlWhole)
    If Not Bul Is Nothing Then
        firstaddress = Bul.Address
        Do
        Asy.Range(Asy.Cells(Bul.Row, "a"), Asy.Cells(Bul.Row, "I")).Copy s.Cells(Sat, "a")
        Sat = Sat + 1
        Set Bul = Aralik.FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> firstaddress
        s.Range("a" & İlk & ":I" & Sat - 1).Sort Key1:=s.Range("C" & İlk), Order1:=xlAscending
        s.Cells(Sat, "F") = WorksheetFunction.Subtotal(9, s.Range(s.Cells(İlk, "f"), s.Cells(Sat - 1, "f")))
        s.Cells(Sat, "G") = WorksheetFunction.Subtotal(9, s.Range(s.Cells(İlk, "g"), s.Cells(Sat - 1, "g")))
        s.Cells(Sat, "E") = "ALTTOPLAM"
        s.Range("e" & Sat & ":g" & Sat).Font.Bold = True
        Sat = Sat + 1
        Application.CutCopyMode = False
    End If
Next
End If
Next
MsgBox "Aktarım tamamlandı.", vbInformation
End Sub

 

[vol1980]

Hocam elinize sağlık.Fakat küçük bir yanlış anlatmam oldu sanırım.Önceki dosyada olduğu gibi önce sarı alana yazdığımız plakaya göre veri sayfasına aktarılacak sonra aktarılan veriler yakıt cinsine göre gruplandırılıp tarih sırasına dizilecek ve her grup için alttoplam alınacaktı.Tam ifade edemediğim için kusura bakmayın.

 

[leumruk]

Merhaba,
Dosyanız ekte.

 

[vol1980]

Hocam şimdi süper oldu.Elinize yüreğinize sağlık.

 

[leumruk]

Hocam şimdi süper oldu.Elinize yüreğinize sağlık.

Rica ederim. İyi çalışmalar.

 

[vol1980]

Hocam sanırım ClearContens çalışmıyor.Sarı sütundan plakaları silip aktar dediğimizde eski verileri silmiyor.Teşekkürler.

 

[leumruk]

Hocam sanırım ClearContens çalışmıyor.Sarı sütundan plakaları silip aktar dediğimizde eski verileri silmiyor.Teşekkürler.

Çalışıyor. O kodu sarı sütunda veri olması şartına bağladım. Ama isterseniz:

s.Range("a2:I65536").ClearContents
s.Range("a2:I65536").ClearFormats

bu kodları hemen üzerlerindeki if ile başlayan satırın üzerine taşırsanız, sarı sütunda veri olsa da olmasa da sayfadaki verileri siler.

 

[vol1980]

Tamamdır.Tekrar teşekkür ederim.

 

[vol1980]

Sayın hocam Ekteki dosyayı kullanıyorum ve çok memnunum sayenizde.Sizden ricam Ana sayfadan veri sayfasına aktarırken Ana sayfada aktardığı satırları herhangi bir renk ile işaretleyebilir mi?
Yada aktardığı satırı ana sayfadan silsede olabilir.
teşekkür ederim.

 

[vol1980]

leumruk hocam ilgilenemiyor musunuz?

 

[leumruk]

Merhaba,
Ekli dosyayı inceleyiniz.

 

[vol1980]

Şimdi çok daha süper hocam teşekkür ederim

 

[leumruk]

Şimdi çok daha süper hocam teşekkür ederim

Rica ederim.k::