Toplam sayıyı diğer sütunlara dağıtma

[mrkync]

a2 hücresinde yazan sayıyı b2 den j2 ye kadar toplamları a2 deki değer olacak şekilde dağıtmak istiyorum
Ancak dağıtırken her sütuna bir değer yazmalı değer eğer 9 dan küçük ise sütunu boş bırakmalı ve eğer ben dağıtılan değerlerin yerini uygun bulmazsan bir tuşla aynı satırdaki ( b2 ile j2 arasındaki değerleri) değerlerin yerlerini değiştirmek istiyorum

Yapmak istediğim olayı örnek dosyada gösterdim.
Yardımlarınız için şimdiden teşekkürler

 

[Muhammet Okumuş]

Merhaba,
Kendi dosyanıza uyarlayabilirsiniz.

 

[mrkync]

Muhammet Bey uyarlamayı yapamadım rica etsem benim örnek dosyam üzerinde bir yardım edebilir misiniz?

 

[Muhammet Okumuş]

Maksimum değer kaç olacak?

 

[mrkync]

Muhammet Bey minimum değer 0 maximum değer ise örnek excel dosyasında gösterdiğim a2 hücresindeki değer olacak a2'deki değeri yandaki 9 hücreye dağıtmaya çalışacak

 

[Muhammet Okumuş]

'--- Muhammet Okumuş. 30.01.2012 Çarşamba 10:32
Sub Sırala()
Application.ScreenUpdating = False
Range("B2:J100") = ""
x = Range("A100").End(3).Row
For i = 2 To x
Range("B" & i & ":J" & i) = 10

Do Until WorksheetFunction.Sum(Range("B" & i & ":J" & i)) = Cells(i, 1)
10
Randomize
a = Int(Rnd() * 9 + 2)
If Cells(i, a) = 0 Then GoTo 10
Cells(i, a) = Cells(i, a) - 1
Loop

Next

End Sub

Range("B" & i & ":J" & i) = 10 bu satırdaki 10 değeri bir sütunun alabileceği maksimum değerdir. 9 sütun olduğu için A sütunudaki değerler maksimum 9*10 = 90 olur. 90 fazla değer vermek istiyorsanız, 10 değerini yükseltiniz.

 

[mrkync]

Çok teşekkürler Muhammet Bey

 

[mrkync]

Muhammet Bey;
sizin vermiş olduğunuz kodlar sorunsuz olarak çalışıyor çok teşekkür ederim ama şimdi kendim hazırlamaya çalıştığım sayfada makroyu yeniden uyarlıyorum ancak devamlı hata veriyor. Size zahmet olmazsa nerede hata yapıyorum bakabilir misiniz? aralık olarak e4 ile m30 arasındaki hücreler için ve dağıtacağı değerlerde O sütununda yer alıyor.

Yardımınız için şimdiden çok çok teşekkür ederim.

 

[mrkync]

Arkadaşlar Muhammet Bey nette değil sanırım yardım edebilecek kimse var mı?

 

[mrkync]

Arkadaşlar yardım edebilecek kimse var mı?

 

[Muhammet Okumuş]

'--- Muhammet Okumuş. 30.01.2012 Çarşamba 10:32
Sub Sırala()
Application.ScreenUpdating = False
Range("C4:N30") = ""
x = Range("O100").End(3).Row
For i = 4 To x
Range("C" & i & ":N" & i) = 20

Do Until WorksheetFunction.Sum(Range("C" & i & ":N" & i)) = Cells(i, 15)
10
Randomize
a = Int(Rnd() * 12 + 3)
If Cells(i, a) = 0 Then GoTo 10
Cells(i, a) = Cells(i, a) - 1
Loop

Next

End Sub

Kodlarını deneyiniz.

 

[mrkync]

Muhammed Bey ben e4 m30 arası yapmak istiyordum siz c ile n sütunları arasında yapmıssınız bende e4 ile m30 arasında yaptım yine kodlar çalışmadı, gördüğüm kadarıyla

Do Until WorksheetFunction.Sum(Range("C" & i & ":N" & i)) = Cells(i, 15)
10
Randomize
a = Int(Rnd() * 12 + 3)
If Cells(i, a) = 0 Then GoTo 10
Cells(i, a) = Cells(i, a) - 1
Loop

olay buradaki kodlarda gizli = Cells(i, 15) ve a = Int(Rnd() * 12 + 3) ne anlama geliyor acaba iki de bir sizi rahatsız etmektense bunları öğrensem daha iyi olacak galiba...

 

[Muhammet Okumuş]

Do Until WorksheetFunction.Sum(Range("C" & i & ":N" & i)) = Cells(i, 15)
(Range("C" & i & ":N" & i)) => C:N aralığını toplar.
Cells(i,15) => O sütunu demektir.
Do Until WorksheetFunction.Sum(Range("C" & i & ":N" & i)) = Cells(i, 15) bu döngüdür.
C:N arası O sütununa eşit oluncaya kadar döngü devam etsin.

a = Int(Rnd() * 12 + 3)
a değer 3 ile 14 arasında değer alır. Bu da hangi sütundan değer düşeceğini gösterir.

a=5 değeri için,

Cells(i, a) = Cells(i, a) - 1
E sütundaki değerden 1 çıkar. Eğer E sütunu 0 ise a değerini değiştir.

 

[Muhammet Okumuş]

Do Until WorksheetFunction.Sum(Range("E" & i & ":M" & i)) = Cells(i, 15)
10
Randomize
a = Int(Rnd() * 9 + 5)

E:M yapmak için değiştiriniz.

 

[mrkync]

çok teşekkürler muhammet bey
kolay gelsin

 

[Muhammet Okumuş]

Rica ederim.
İyi çalışmalar.