Saatlerin Random Bölünmesi

[seven058]

Herkese Selamlar,

Aşağıdaki tabloda saatleri random ilgili sütunlara dağıtmak istiyorum. Ancak her bir parça 3 saati aşmayacak ve toplamda yine A sütununda verilen saat yapacak.

Bu konuda yardım ederseniz çok memnun olurum. Destek veren herkese şimdiden teşekkür ederim.

 

[ÖmerFaruk]

Mesela Saat 10:00:00 için, 4'e bölünecek demek
C-J sütunlarından sadece herhangi 4 ünde ve her biri maksimum 3 saat ve toplamı 10 saat olmak şartıyla dağıtılması mıdır?

 

[seven058]

Evet Ömer Bey. Belirttiğiniz gibi olacak.

 

[ÖmerFaruk]

Kodlar aşağıda.
Module eklenmiş vaziyette örnek dosyanız (Altın üyesiniz siz ekleyebilirdiniz) ektedir.

Sub SaatBöl()
Dim TopZaman As Double, MinZaman As Double, MaxZaman As Double, MaxSaat As Integer
MaxSaat = 3
MaxZaman = TimeSerial(MaxSaat, 0, 0) * 1
Range("C2:J" & Range("A" & Rows.Count).End(3).Row).ClearContents
For i = 2 To Range("A" & Rows.Count).End(3).Row
    TopZaman = 0
    Say = 0
    Do Until WorksheetFunction.CountA(Range("C" & i, "J" & i)) = Range("B" & i)
        Do
            Randomize
            Seç = Int(Rnd() * 8) + 1
            If Range("A" & i).Offset(0, 1 + Seç) = "" Then
                Say = Say + 1
                Exit Do
            End If
        Loop
        MinZaman = Range("A" & i) - TopZaman - (Range("B" & i) - Say) * MaxZaman
        If Say = Range("B" & i) Then
            Cells(i, Seç + 2) = Range("A" & i) - TopZaman
        Else
        Randomize
        Cells(i, Seç + 2) = MinZaman + Rnd * (MaxZaman - MinZaman)
        TopZaman = TopZaman + Cells(i, Seç + 2)
        End If
    Loop
Next
End Sub