Soru Önce sonra süreler formatı

[emreeyy]

Merhaba,
örnek dosyam ektedir.

A1:BO7 arasında süre kayıtlarını tuttuğum veritabanım mevcut.
A11:M18 arasında ise dönüştürmek istediğim örnek formatım mevcut.
A10602 parçası için 2 kayıt mevcut
A1 satırı öncesi A2 satırı ise sonrası süre olarak değerlendirip
A13 teki örnek formata sokuyorum.

Eğer op no'ları farklı ise bunları önce sonra süre olarak değerlendirmemem gerekiyor.

B00966 için 4 kayıt var.
A4 satırı A5 satırının önce süresi
A5 satırı A6 satırının önce süresi
Fakat A7 opno 20 olduğu için bağımsız bir süre oluyor.O yüzden op10 - op20 önce sonra olarak değerlendirmemem gerekiyor.
Veri tabanımda şuan 800 adet önce sonra süre mevcut
Ben otomatik bir şekilde istediğim formata(A11:M18 arası) dönüştürebilir miyim?

 

[emreeyy]

Konu günceldir..

 

[veyselemre]

Rapor isminde bir çalışma sayfası ekleyin çalışmanıza;

Sub eskiYeniRapor()
'08042019 veyselEMRE
    Sheets("VT").Select

    ActiveSheet.Copy
    Columns("A:BO").Select
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange Range("A1:BO7")
        .Header = xlYes
        .Apply
    End With
    Range("C:C,F:L,N:BF,BH:BO").Delete Shift:=xlToLeft
atla:
    ver = Range("A2:F" & Cells(Rows.Count, 1).End(3).Row).Value
    ActiveWorkbook.Close False

    Sheets("Rapor").Select
    sat = 2
    With CreateObject("Scripting.Dictionary")
        For i = LBound(ver) To UBound(ver)
            ky = ver(i, 1) & "|" & ver(i, 2)
            .Item(ky) = .Item(ky) & "," & i
        Next i
        itm = .items
        For i = LBound(itm) To UBound(itm)
            esk = 0
            yeni = 0
            bl = Split(itm(i), ",")
            If UBound(bl) > 0 Then
                For ii = 1 To UBound(bl)
                    If esk = 0 Then esk = CInt(bl(ii))
                    If esk >= yeni Then yeni = CInt(bl(ii))
                    If yeni > esk Then
                        Cells(sat, 1) = sat - 1
                        Cells(sat, 2) = ver(esk, 1)
                        Cells(sat, 3) = ver(esk, 2)
                        Cells(sat, 4) = ver(esk, 5)
                        Cells(sat, 5) = ver(esk, 3)
                        Cells(sat, 6) = Cells(sat, 4) * Cells(sat, 5)
                        Cells(sat, 7) = ver(yeni, 5)
                        Cells(sat, 8) = ver(yeni, 3)
                        Cells(sat, 9) = Cells(sat, 7) * Cells(sat, 8)
                        Cells(sat, 10) = ver(yeni, 4)
                        Cells(sat, 11) = ver(esk, 6)
                        esk = yeni
                        sat = sat + 1
                    End If
                Next ii
            End If
       Next i
    End With
End Sub

 

[emreeyy]

Rapor isminde bir çalışma sayfası ekleyin çalışmanıza;

Sub eskiYeniRapor()
'08042019 veyselEMRE
    Sheets("VT").Select

    ActiveSheet.Copy
    Columns("A:BO").Select
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("B2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("E2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SortFields.Add Key:=Range("G2"), SortOn:=xlSortOnValues, Order:=xlAscending
        .SetRange Range("A1:BO7")
        .Header = xlYes
        .Apply
    End With
    Range("C:C,F:L,N:BF,BH:BO").Delete Shift:=xlToLeft
atla:
    ver = Range("A2:F" & Cells(Rows.Count, 1).End(3).Row).Value
    ActiveWorkbook.Close False

    Sheets("Rapor").Select
    sat = 2
    With CreateObject("Scripting.Dictionary")
        For i = LBound(ver) To UBound(ver)
            ky = ver(i, 1) & "|" & ver(i, 2)
            .Item(ky) = .Item(ky) & "," & i
        Next i
        itm = .items
        For i = LBound(itm) To UBound(itm)
            esk = 0
            yeni = 0
            bl = Split(itm(i), ",")
            If UBound(bl) > 0 Then
                For ii = 1 To UBound(bl)
                    If esk = 0 Then esk = CInt(bl(ii))
                    If esk >= yeni Then yeni = CInt(bl(ii))
                    If yeni > esk Then
                        Cells(sat, 1) = sat - 1
                        Cells(sat, 2) = ver(esk, 1)
                        Cells(sat, 3) = ver(esk, 2)
                        Cells(sat, 4) = ver(esk, 5)
                        Cells(sat, 5) = ver(esk, 3)
                        Cells(sat, 6) = Cells(sat, 4) * Cells(sat, 5)
                        Cells(sat, 7) = ver(yeni, 5)
                        Cells(sat, 8) = ver(yeni, 3)
                        Cells(sat, 9) = Cells(sat, 7) * Cells(sat, 8)
                        Cells(sat, 10) = ver(yeni, 4)
                        Cells(sat, 11) = ver(esk, 6)
                        esk = yeni
                        sat = sat + 1
                    End If
                Next ii
            End If
       Next i
    End With
End Sub

Hocam süper çalışıyor.
Ben yeni süre eklediğimde hepsini baştan hesaplıyor.
Bunun yerine yeni eklenenler listenin altına eklenebilir mi?