sayıyı eşit olmayacak şekilde parçalara ayırmak

[hallil237]

yukarıda excel dosyasında belirttiğim gibi rakamı eşit olmayacak şekilde parçalara ayırmama yardımcı olursanız sevinirim

 

[ÖmerBey]

B3 hücresine:

=EĞER(B2>7000;7000;B2)

yazınız.
B4 hücresine de

=EĞER($B$2-TOPLA($B$3:B3)>7000;7000;$B$2-TOPLA($B$3:B3))

yazıp aşağı çekerek çoğaltınız.

Düzeltme:
Makro kodu aşağıdadır:

Sub kod()
değer = Range("B2").Value
sat = 3
Range("B3:B65500").ClearContents
Do
    If değer > 7000 Then
        Cells(sat, "B") = 7000
        değer = değer - 7000
    Else
        Cells(sat, "B") = değer
        değer = 0
    End If
    sat = sat + 1
Loop Until değer = 0
Cells(sat, "B") = değer
End Sub

 

[hallil237]

yanıtınız için teşekkürler ; ancak istediğimiz şey tam olarak bu değil her bir tutarın sabit 7000 tl değil en çok 7000 tl olacak şekilde birbirinden farklı tutarlarda olup en son satırda kalanın da 7000 veya altında bir rakam çıkmasını istiyorum

 

[Korhan Ayhan]

Deneyiniz...

Sub Degeri_Parcala()
    Deger = Range("B2").Value
    Satir = 3
    Range("B3:B" & Rows.Count).ClearContents
10  Randomize Timer
    Sayi = Int((Rnd() * 7000) + 1)
    If Sayi <= 7000 Then
        If (WorksheetFunction.Sum(Range("B3:B" & Rows.Count)) + Sayi) < Deger Then
            Cells(Satir, 2) = Sayi
            Satir = Satir + 1
            GoTo 10
        Else
            Cells(Satir, 2) = Deger - WorksheetFunction.Sum(Range("B3:B" & Rows.Count))
        End If
    End If

    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[ÖmerBey]

Sağolsun, Korhan Bey cevap vermiş ama alternatif olsun, yukarıdaki kodun revize edilmiş hali:

Sub kod()
değer = Range("B2").Value
sat = 3
Range("B3:B65500").ClearContents
Randomize
Do
    If değer > 7000 Then
        sayı = WorksheetFunction.Round(Rnd * 7000, [COLOR="Red"]2[/COLOR])
        Cells(sat, "B") = sayı
        değer = değer - sayı
    Else
        Cells(sat, "B") = değer
        değer = 0
    End If
    sat = sat + 1
Loop Until değer = 0
End Sub

 

[hallil237]

üstadlarım hepinize teşekkür ederim

 

[hallil237]

Deneyiniz...

Sub Degeri_Parcala()
    Deger = Range("B2").Value
    Satir = 3
    Range("B3:B" & Rows.Count).ClearContents
10  Randomize Timer
    Sayi = Int((Rnd() * 7000) + 1)
    If Sayi <= 7000 Then
        If (WorksheetFunction.Sum(Range("B3:B" & Rows.Count)) + Sayi) < Deger Then
            Cells(Satir, 2) = Sayi
            Satir = Satir + 1
            GoTo 10
        Else
            Cells(Satir, 2) = Deger - WorksheetFunction.Sum(Range("B3:B" & Rows.Count))
        End If
    End If

    MsgBox "İşleminiz tamamlanmıştır."
End Sub

korhan bey merhaba cevabınız için tekrar teşekkür ederim bir şey daha sorabilir miyim? söz konusu b sütünundaki 7000 < rakamı parçalara ayırıyor ben hem b hemde c sütununa rakam yazarak parçalama yapmasını nasıl sağlayabilirm