Verim hesaplama

[YUSUF44]

Anlamadım maalesef.

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 ?

Burdakinden farklı bir sonuç mu istiyorsunuz yani? Eğer öyleyse küçük bir örnek dosyada tam olarak anlamamızı sağlayacak şekilde manuel çözüm paylaşın lütfen.

 

[Kavinsky]

Buyurun hocam açıklamaya çalıştım dilim döndükçe

Oda verim hesabı.xlsm

dosyayı indir, full download - Oda verim hesabı.xlsm

dosya.org

 

[YUSUF44]

Aşağıdaki kodları deneyin:

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")
        s2.Range("I3:I" & son2).Copy s1.Cells(yeni, "C")
    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")
        s3.Range("G2:G" & son3).Copy: s1.Cells(yeni, "C").PasteSpecial Paste:=xlValues
    End If
    
    son = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Sort.SortFields.Clear
    s1.Sort.SortFields.Add Key:=Range("B2:B" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s1.Sort.SortFields.Add Key:=Range("A2:A" & son) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With s1.Sort
        .SetRange Range("A1:C" & son)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    For k = son To 2 Step -1
        If s1.Cells(k, "A") = s1.Cells(k + 1, "A") Then
            s1.Cells(k, "C") = s1.Cells(k + 1, "C") + s1.Cells(k, "C")
            s1.Rows(k + 1).Delete
        End If
    Next
    
    enson = s1.Cells(Rows.Count, "A").End(3).Row
    s1.Range("A1:C" & son).HorizontalAlignment = xlCenter
    s1.Range("B2:B" & enson).HorizontalAlignment = xlLeft
    s1.Range("C2:C" & enson).HorizontalAlignment = xlRight
    s1.Range("A1:C" & enson).VerticalAlignment = xlCenter
    s1.Range("C2:C" & enson).NumberFormat = "#,##0"" kg"""
Application.ScreenUpdating = True

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

End Sub

 

[Kavinsky]

Hay Allah tuttuğunu altın etsin üstat çok uğraştırdım seni hakkını helal et ama tam kafamdaki şey oldu. Çok uğraşıyordum bunlar için.