sekmelerdeki firma verilerini bi takım kurallara göre özetleme

[modoste]

Merhaba Sayın hocalarım
sorumun başlığına sığdıramadığım ifademi yazmak istiyorum
ekli tablomdada görüldüğü üzere sorumda 3 firma adı yazdım (X-Y-Z firması)
bu firmalar sene içinde 20 ye kadar çıkabiliyo
her firma adına hazırlanmış çizelge şablonları aynı 20. satırda veriler başlıyo ve 365 satır aşağıda bitiyo yani 1 yıllık altalta verileri yazıldığı tablolardır.
her sekmenin A sutununda malzemelerin verildiği kısım yazar
(örneğin bizim firmada 2 şantiye var) aralarında 30 km var malzemeyi hangi yerden verdiğimiz önemli yani
sorduğum soru için bu veriler (A ve B)
Her Sekmenin B3:G17 arasındaki sonuçlamaları 2009 yılında siz sayın hocalarımdan alternatifli formülleriyle beraber öğrenmiş bulunmaktayım.
bu kısımlarla ilgili herhangi bi sorum yok.

İstenen sekmesinde sarı ile renklendirdiğim yerlerin dolmasını istiyorum
malum her gün firmalara malzeme vermediğimizden dolayı sadece malzeme verdiğim günlere göre (X-Y-Z) firmalarının kendi içinde sıralaması olmamak kaydıyla verilerin düşey bi şekilde listelemek istiyorum ki daha sonra bu tablodan başka formülasyonlar yapmam lazım.

sarı renkli kısımda manuel olarak ilk veriyi kendim yazdım.

 

[Ergün Güler]

Selam,
örnek dosyanıza bir modül ekleyerek aşağıdaki kodu uygulayınız.
daha sonra "istenen" adlı sayfanızda Form'dan bir düğme oluşturup, bu düğmeye aşağıdaki makroyu atayınız.
Kodlar Sayın Korhan Ayhan'dan alıntıdır.

Option Explicit
 
Sub ÖZET_LİSTE()
    Dim SL As Worksheet, SAYFA As Worksheet, X As Long, SATIR As Long
    
    Set SL = Sheets("istenen")
    
    SL.Range("B20:I65536").ClearContents
    SATIR = 20
    
    For Each SAYFA In ThisWorkbook.Worksheets
        If SAYFA.Name = "X Firması" Or SAYFA.Name = "Y Firması" Or SAYFA.Name = "Z Firması" Then
            For X = 20 To SAYFA.Range("B65536").End(3).Row
                If SAYFA.Cells(X, 3) <> "" Or SAYFA.Cells(X, 4) <> "" Or SAYFA.Cells(X, 5) <> "" Or SAYFA.Cells(X, 6) <> "" Or SAYFA.Cells(X, 7) <> "" Then
                    SL.Cells(SATIR, 2) = SAYFA.Cells(X, 1)
                    SL.Cells(SATIR, 3) = SAYFA.Name
                    SL.Cells(SATIR, 4) = SAYFA.Cells(X, 2)
                    SL.Cells(SATIR, 5) = SAYFA.Cells(X, 3)
                    SL.Cells(SATIR, 6) = SAYFA.Cells(X, 4)
                    SL.Cells(SATIR, 7) = SAYFA.Cells(X, 5)
                    SL.Cells(SATIR, 8) = SAYFA.Cells(X, 6)
                    SL.Cells(SATIR, 9) = SAYFA.Cells(X, 7)
                    
                  
                    SATIR = SATIR + 1
                End If
            Next
        End If
    Next
 
    SL.Select
    Range("B20:I65536").Sort Key1:=Range("D20"), Order1:=xlAscending
 
    Set SL = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

iyi çalışmalar.

 

[modoste]

sayın ergün güler hocam teşekkür ederim çözümünüz için
fonksiyonlar ile çözümünü kullanmak istiyorum (tabloların düzeninde değişiklikler yapsam bile çözümü verilmiş bir fonksiyonda üzerinde değişiklik yaparak uyarlayabilyorum makro bilgim kötü olduğundan fonksiyonlar ile çözümünü öğrenmek istiyorum.

düğme atama vs konularında bilgim olmadığından çözümlü dosya ekleyebilirmisiniz hocam.

 

[Ergün Güler]

sayın ergün güler hocam teşekkür ederim çözümünüz için
fonksiyonlar ile çözümünü kullanmak istiyorum (tabloların düzeninde değişiklikler yapsam bile çözümü verilmiş bir fonksiyonda üzerinde değişiklik yaparak uyarlayabilyorum makro bilgim kötü olduğundan fonksiyonlar ile çözümünü öğrenmek istiyorum.

düğme atama vs konularında bilgim olmadığından çözümlü dosya ekleyebilirmisiniz hocam.

Selam
çözüm ektedir.
"istenen" adlı sayfadali "listele" butonuna tıklayınız.
iyi çalışmalar.

 

[modoste]

sayın hocam bu çözümü az önce kullandım çok teşekkür ederim
bu çözümün formüllü olanı varsa onu öğrenmek istiyorum.

 

[Ergün Güler]

sayın hocam bu çözümü az önce kullandım çok teşekkür ederim
bu çözümün formüllü olanı varsa onu öğrenmek istiyorum.

Ben de Fonksiyonlar ile olanını merak ediyorum.
İyi çalışmalar.