Soru Kapasite Planlaması

[Archonel]

Bir işleme tezgahında yapılacak olan parçaları yukarıdan aşağıya sıralanmış şekilde günlere atamak istiyorum. Günlük kapasite (standart + vardiya + mesai) süresi dolana kadar parça atamasını yaptırmak, o günkü kapasite dolduktan sonra bir sonraki günden devam ederek atamayı sürdürmesini istiyorum. Ulaşmak istediğim noktayı 'Örnek' sekmesinde belirttim. Yardımcı olursanız çok sevinirim.

 

[ÖmerFaruk]

Kullandığım kod aşağıdadır.
Dosyanızda çalışma sürelerinin olduğu satırları yer değiştirdim ki üretim partilerini aşağı doğru istediğiniz kadar arttırabilesiniz.
Dosyayı da bu formatta yeniden paylaşıyorum.
Kodları arzuladığınız şekilde sayfa üzerinde çalışıtrabilrisiniz.

Not: Sonuçların hepsini kontrol etmedim. Doğru olduğunu umuyorum. Ayrıca sizin verdiğiniz bilgi ve kısıtlara ilaveten günlük kalan süre eğer sıradaki parçadan en az 1 adet üretemiyorsa gün atlattırdım.

Sub KapasitePlanlama()
    Range("E6:XFD6").ClearContents
    Son = Range("A" & Rows.Count).End(3).Row
    If Son < 7 Then Exit Sub
    myDay = 5
    KalanSüre = Cells(2, myDay)
    i = 7
    Adet = Range("B" & i)
    Süre = Range("C" & i)
    Do
        Sayı = WorksheetFunction.Min(Adet, Int(KalanSüre / Süre))
        If Sayı > 0 Then
            Yaz = Yaz & Chr(10) & Range("A" & i)
            KalanSüre = KalanSüre - Süre * Sayı
            Adet = Adet - Sayı
            If Adet = 0 Then
                i = i + 1
                Adet = Range("B" & i)
                Süre = Range("C" & i)
            End If
        End If
        If Sayı < 1 Or KalanSüre < Süre Or i > Son Then
            Cells(6, myDay) = Mid(Trim(Yaz), 2, 9999)
            myDay = myDay + 1
            KalanSüre = Cells(2, myDay)
            Yaz = ""
        End If
    Loop Until i > Son
End Sub

 

[Archonel]

Teşekkür ederim Ömer Bey. Kusursuz çözüm olmuş, elinize sağlık.

 

[ÖmerFaruk]

Eyvallah

 

[Archonel]

Ömer Bey, A sütunundaki stok kodlarını, biçimleriyle birlikte dağıtım satırına yazdırmamız mümkün müdür? Ekli excelde manuel yaparak göstermeye çalıştım. Yardımlarınızı bekliyorum.

 

[ÖmerFaruk]

İlk verdiğim kodların yerine aşağıdaki kodları kullanabilirsin.

Sub KapasitePlanlama()
    Dim Renkler As Object, myStart As Integer
    Range("E6:XFD6").ClearContents
    Range("E6:XFD6").Font.ColorIndex = xlAutomatic
    Son = Range("A" & Rows.Count).End(3).Row
    If Son < 7 Then Exit Sub
    myDay = 5
    KalanSüre = Cells(2, myDay)
    i = 7
    Adet = Range("B" & i)
    Süre = Range("C" & i)
    Set Renkler = CreateObject("Scripting.Dictionary")
    Do
        Sayı = WorksheetFunction.Min(Adet, Int(KalanSüre / Süre))
        If Sayı > 0 Then
            Yaz = Yaz & Chr(10) & Range("A" & i)           
            If Not Renkler.Exists(Range("A" & i)) Then Renkler.Add Range("A" & i), Range("A" & i).Font.Color
            KalanSüre = KalanSüre - Süre * Sayı
            Adet = Adet - Sayı
            If Adet = 0 Then
                i = i + 1
                Adet = Range("B" & i)
                Süre = Range("C" & i)
            End If
        End If
        If Sayı < 1 Or KalanSüre < Süre Or i > Son Then
            Cells(6, myDay) = Mid(Trim(Yaz), 2, 9999)
            myStart = 1
            For Each Renk In Renkler.Keys
                myLen = Len(Renk)
                Cells(6, myDay).Characters(Start:=myStart, Length:=Len(Renk)).Font.Color = Renkler(Renk)
                myStart = myStart + Len(Renk) + 1
            Next Renk
            myDay = myDay + 1
            KalanSüre = Cells(2, myDay)
            Yaz = ""
            Renkler.RemoveAll
        End If
    Loop Until i > Son
    Set Renkler = Nothing
End Sub

 

[Archonel]

Tekrar teşekkür ederim, elinize sağlık.