• DİKKAT

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

Verim hesaplama

Katılım
5 Şubat 2016
Mesajlar
274
Excel Vers. ve Dili
Office 365 Türkçe
Merhaba,üretim odalarımda oda başına toplam kaç kg ürün toplanmış PAZAR (pazarda satılan ürün) VE PERSPEKTİF (paketlenip satılan ürün) sayfalarından toplam alıp VERİM isimli sayfaya bunu yazmasını istiyorum. Örneğin 1 numaralı oda 10 haziranda üretime geçmiş 30 haziranda bitmiş bu iki tarih arasındaki verimi alırsa benim işimi görür. Odalar sıralı üretim yaptığı için tarihler arasındaki üretim sadece belli odaya ait. Şimdiden teşekkür ederim.

 
Merhaba,üretim odalarımda oda başına toplam kaç kg ürün toplanmış PAZAR (pazarda satılan ürün) VE PERSPEKTİF (paketlenip satılan ürün) sayfalarından toplam alıp VERİM isimli sayfaya bunu yazmasını istiyorum. Örneğin 1 numaralı oda 10 haziranda üretime geçmiş 30 haziranda bitmiş bu iki tarih arasındaki verimi alırsa benim işimi görür. Odalar sıralı üretim yaptığı için tarihler arasındaki üretim sadece belli odaya ait. Şimdiden teşekkür ederim.


ODA NO

HASAT BAŞLAMA TARİHİ

TOPLAM KG

1

4 Mart 2021 Perşembe​

341
bu şekilde mi olacak acaba
 
Örnek dosyanızda VERİM sayfası nasıl olmalıydı? Manuel doldurup paylaşır mısınız?
 
Merhaba , sistem çalışınca şöyle bir sonuç vermesi gerekmekte. Bir de yeni ekim yapıldığında onu alt satıra eklemeli. 1 numaralı odaya tekrar ekim oldu onu da verim olarak işlemeli. Nasıl olacak bilmiyorum ama , benim kafam basmadı kendi isteğime bile :) yani sürekli olarak ben hangi odadan ne kadar verim oldu bunu listeleyip yıl sonunda verimleri incelemek istiyorum amacım bu.


ODA NO

HASAT BAŞLAMA TARİHİ

TOPLAM KG

1

4 Mart 2021 Perşembe

1053

2

3 Nisan 2021 Cumartesi

793

3

14 Nisan 2021 Çarşamba

742
 
Gördüğünüz üzere bu şekildeki paylaşımınız pek düzgün görünmüyor. Dosya üzerinde gösterirseniz daha iyi olur.
 
Kusura bakmayın, konuyu gözden kaçırmışım.

Aşağıdaki kodları bir modüle kopyalayıp deneyin. Makro çalıştığında VERİM sayfasını önce temizler, sonra her iki sayfadaki bilgilere göre son duruma göre günceller:

PHP:
Sub verimler()
Set s1 = Sheets("VERİM")
Set s2 = Sheets("PERSPEKTİF")
Set s3 = Sheets("PAZAR")

eski = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "A").End(3).Row
son3 = s3.Cells(Rows.Count, "I").End(3).Row
If eski > 1 Then
    s1.Range("A2:C" & eski).ClearContents
End If
Application.ScreenUpdating = False

    If son2 > 2 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Range("A3:A" & son2).Copy s1.Cells(yeni, "A")
        s2.Range("F3:F" & son2).Copy s1.Cells(yeni, "B")
    End If
    
    If son3 > 1 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s3.Range("I2:I" & son3).Copy s1.Cells(yeni, "A")
        s3.Range("F2:F" & son3).Copy s1.Cells(yeni, "B")
    End If
    
    son = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Range("$A$1:$C$" & son).RemoveDuplicates Columns:=Array(1, 2), Header _
            :=xlYes
    enson = s1.Cells(Rows.Count, "A").End(3).Row
    
    If enson > 1 Then
        For i = 2 To enson
            s1.Cells(i, "C") = WorksheetFunction.SumIfs(s2.Range("E2:E" & son2), s2.Range("A2:A" & son2), s1.Cells(i, "A"), _
                                s2.Range("F2:F" & son2), s1.Cells(i, "B")) + WorksheetFunction.SumIfs(s3.Range("G1:G" & son3), _
                                s3.Range("I1:I" & son3), s1.Cells(i, "A"), s3.Range("F1:F" & son3), s1.Cells(i, "B"))
         Next
    End If
Application.ScreenUpdating = True

s1.Activate
MsgBox "İşlem tamamlandı", vbExclamation

End Sub
 
Yusuf hocam çok teşekkür ederim öncelikle emeğine sağlık. Alt alta yazıyor ya verileri mesela 1.odaya ait 4-5 tane veri bulup alt alta yazıyor. Ben bunları toplayarak yazmasını istiyorum. Yani 1 satır olsun oda 1 onda da toplam verimi göreyim. Bir de hata yapmışım ,PERSPEKTİF sayfası A sütunu ile değil E sütunu ile başlıyor hocam. Bu şekilde yardımcı olabilme imkanınız olabilir mi acaba ?
 
Yusuf hocam çok teşekkür ederim öncelikle emeğine sağlık. Alt alta yazıyor ya verileri mesela 1.odaya ait 4-5 tane veri bulup alt alta yazıyor. Ben bunları toplayarak yazmasını istiyorum. Yani 1 satır olsun oda 1 onda da toplam verimi göreyim. Bir de hata yapmışım ,PERSPEKTİF sayfası A sütunu ile değil E sütunu ile başlıyor hocam. Bu şekilde yardımcı olabilme imkanınız olabilir mi acaba ?
Aynı odaya ait birden fazla satır olması, odadaki işlemlerin birden fazla günde gerçekleşmesinden kaynaklanıyor. VERİM sayfasında tarih için ayrı sütun olduğundan, her tarihin ayrı ayrı listelenmesi gerektiğini düşünmüştüm. Aşağıdaki kodları deneyiniz:

PHP:
Sub verimler()
Set s1 = Sheets("VERİM")
Set s2 = Sheets("PERSPEKTİF")
Set s3 = Sheets("PAZAR")

eski = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "E").End(3).Row
son3 = s3.Cells(Rows.Count, "I").End(3).Row

If eski > 1 Then
    s1.Range("A2:C" & eski).ClearContents
End If

Application.ScreenUpdating = False
    If son2 > 2 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Range("E3:E" & son2).Copy s1.Cells(yeni, "A")
        s2.Range("J3:J" & son2).Copy s1.Cells(yeni, "B")
    End If
    
    If son3 > 1 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s3.Range("I2:I" & son3).Copy s1.Cells(yeni, "A")
        s3.Range("F2:F" & son3).Copy s1.Cells(yeni, "B")
    End If
    
    son = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add2 Key:=Range("A2:A" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s1.Sort.SortFields.Add2 Key:=Range("B2:B" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VERİM").Sort
        .SetRange Range("A1:C" & son)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    s1.Range("$A$1:$C$" & son).RemoveDuplicates Columns:=1, Header:=xlYes
    
    enson = s1.Cells(Rows.Count, "A").End(3).Row
    
    If enson > 1 Then
        For i = 2 To enson
            s1.Cells(i, "C") = WorksheetFunction.SumIf(s2.Range("I1:I" & son2), s1.Cells(i, "A"), s2.Range("E1:E" & son2)) + _
                                WorksheetFunction.SumIf(s3.Range("I1:I" & son3), s1.Cells(i, "A"), s3.Range("G1:G" & son3))
        Next
    End If
    
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("B2:B" & enson), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VERİM").Sort
        .SetRange Range("A1:C" & enson)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    s1.Range("A1:C" & enson).HorizontalAlignment = xlCenter
    s1.Range("B1:B" & enson).HorizontalAlignment = xlLeft
    s1.Range("A1:C" & enson).VerticalAlignment = xlCenter
    
Application.ScreenUpdating = True

s1.Activate
MsgBox "İşlem tamamlandı", vbExclamation

End Sub
 
Son düzenleme:
s1.Sort.SortFields.Add2 Key:=Range("A2:A" & son) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

Bu bölümde hata verdi. Ve bu şekilde bir raporlama yaptı üstat. Ben mi bir yerde yanlış yaptım acaba ?
2021-06-19-19-17-31.png
 
Ben denediğimde düzgün sonuç vermişti. Eğer örnek excel dosyanızda makroyu uyguladığınız ve hata aldığınız haliyle paylaşırsanız incelemeye çalışırım.
 
Aşağıdaki kodu deneyin:

PHP:
Sub verimler()
Set s1 = Sheets("VERİM")
Set s2 = Sheets("PERSPEKTİF")
Set s3 = Sheets("PAZAR")

eski = s1.Cells(Rows.Count, "A").End(3).Row
son2 = s2.Cells(Rows.Count, "E").End(3).Row
son3 = s3.Cells(Rows.Count, "I").End(3).Row

If eski > 1 Then
    s1.Range("A2:C" & eski).ClearContents
End If

Application.ScreenUpdating = False
    If son2 > 2 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s2.Range("E3:E" & son2).Copy s1.Cells(yeni, "A")
        s2.Range("J3:J" & son2).Copy s1.Cells(yeni, "B")
    End If
    
    If son3 > 1 Then
        yeni = s1.Cells(Rows.Count, "A").End(3).Row + 1
        s3.Range("I2:I" & son3).Copy s1.Cells(yeni, "A")
        s3.Range("F2:F" & son3).Copy s1.Cells(yeni, "B")
    End If
    
    son = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add2 Key:=Range("A2:A" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s1.Sort.SortFields.Add2 Key:=Range("B2:B" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VERİM").Sort
        .SetRange Range("A1:C" & son)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    s1.Range("$A$1:$C$" & son).RemoveDuplicates Columns:=1, Header:=xlYes
    
    enson = s1.Cells(Rows.Count, "A").End(3).Row
    
    If enson > 1 Then
        For i = 2 To enson
            s1.Cells(i, "C") = WorksheetFunction.SumIf(s2.Range("E1:E" & son2), s1.Cells(i, "A"), s2.Range("I1:I" & son2)) + _
                                WorksheetFunction.SumIf(s3.Range("I1:I" & son3), s1.Cells(i, "A"), s3.Range("G1:G" & son3))
        Next
    End If
    
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("B2:B" & enson), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("VERİM").Sort
        .SetRange Range("A1:C" & enson)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    s1.Range("A1:C" & enson).HorizontalAlignment = xlCenter
    s1.Range("B1:B" & enson).HorizontalAlignment = xlLeft
    s1.Range("A1:C" & enson).VerticalAlignment = xlCenter
    
Application.ScreenUpdating = True

s1.Activate
MsgBox "İşlem tamamlandı", vbExclamation

End Sub
 
Üstat aynı kodu olduğu gibi yapıştırdım siteye yüklediğim dosyaya, fakat yine debug çıktı hata verdi. Sizden ricam yüklediğim dosyaya uygulayıp çalışan bir dosyayı yükleyip link vermeniz mümkün müdür? Uğraştınız farkındayım ,teşekkür ederim. Olmazsa pes edeceğim zaten :)
 
Bu arada bende çalışan kodların sizde çalışmaması durumunda muhtemelen uyguladığınız dosya ile paylaştığınız dosya arasında yapısal farklılıklar vardır.
 
Evet hocam yüksek ihtimal öyle. Sizin yüklediğiniz dosyayı indirdim, çalıştırınca makroyu sizin dosyanızda da aşağıda belirttiğimi kısımda hata verdi. Belki de problem benim Office 2010 kullanmam ile alakalıdır. Yine de çok teşekkür ederim, çok emek harcadınız ellerinize sağlık.

Kod:
s1.Sort.SortFields.Add2 Key:=Range("A2:A" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
 
Add2'yi Add olarak düzeltip deneyin, belki düzelir.
 
Dediğinizi yapınca oldu hocam , çok enteresan :) . Kod çalışınca tabi olayı görebildim. Yazmaya artık utanıyorum demek istediğim ana toplam değil de alt alta toplamasıydı. 1 leri toplasın altına oda 2 toplasın altına oda 3 sonra tekrar sıradaki verimi toplasın gibi demiştim. Yani hangi dönem hangi oda ne kadar verim yaptığını görmek istiyorum. Yani tüm oda 2 leri tek satırda değil de alt alta olması hasebiyle diğer oda hasatı gelene kadar olanları toplasın. Umarım anlatabilmişimdir aklımdakini. Uğraştıracaksa hocam zaman ayıramazsın hiç sıkıntı değil. Ben bile yoruldum :) kaldı ki sen kodları yazdın.

2021-06-22-19-42-05.png
 
Geri
Üst