『VBAで合計数値をランダム分配』について

質問

『VBAで合計数値をランダム分配』について

Excel2007を使用しています。

特定個数のものをランダム分配する方法を探しています。
簡単に申しますと、『10個のリンゴを、A~C君の3人にランダムに配る』みたいなものです。

可能であれば、後ろの分配比率が高くなると嬉しいです。
＊A君1個　B君3個　C君6個　のような感じです。

是非是非教えてください。
よろしくお願いいたします。

回答No.5

merlionXX

> 『極端な偏り』を薄めるには・・・

momoko_さん、こんにちは。
なぜ、偏るのか考えてみました。
最初に0～10の間の整数をランダムにだしますから、平均すると満遍なくやれば平均は5.5になります。
次に、やはり0～10の間の整数をランダムにだし、最初の数字と足して10を超えなければ確定しますからこの平均は4.5になりますね。
だから残りの一番少ない数は0が極端に多くなってしまったというわけです。
ランダムを安易に考えてしまったことによる失敗でした。（勉強になりました。）

解消するには別の方法を考えなければいけませんね。
ランダムな数値を３つ出して、１０をその３つの数値の比率で配分するのがよさげです。

やってみました。
こんどはいかがでしょう？
なお、Small関数の引数に+1をしているのは、配列の添字（0～2）を順位1～3に読み替えるためです。

Sub test03()
　　Dim myNum(2) As Single, t As Single
　　Dim mySep(2) As Integer, i As Integer, n As Integer
　　Dim myAns(2) As Variant
　　Randomize
　　For i = 0 To 2
　　　　myNum(i) = Rnd
　　　　t = t + myNum(i)
　　Next i
　　For i = 0 To 1
　　　　mySep(i) = Int(myNum(i) / t * 10)
　　　　n = n + mySep(i)
　　Next i
　　mySep(2) = 10 - n
　　For i = 0 To 2
　　　　myAns(i) = Application.Small(mySep, i + 1)
　　Next i
　　MsgBox "A, B, Cは以下の個数で分配:" & vbNewLine & Join(myAns, "個、") & "個"
End Sub

回答No.4

m_and_dmp

こんな感じです。
セル"3B"に個数、"3C"に人数、"3D"に整形指数（任意の正の数）を入れておきます。
セル"4B"～には「Aさん」、「Bさん」、「Cさん」．．．と好きなだけ。
セル"5B"～に分配数が出力されます。
個数、人数は任意です。100個、2人～24人まで試しました。
整形指数をゼロにすると、完全にランダムに配分され、ゼロの人が出てくることがあります。
数値を大きくすると分配比がフラットになります。極端に大きくすると「皆同じ」になります。
以下のマクロコードの　DNT(i) = Application.Small(DNI, i + 1)　についてですが、
どうして、.....(DNI, i + 1) とプラス1しなくてはならないのか分かりません。プラス1しないと誤った結果がでます。
If DNITotal < n1 Then DNI(1) = DNI(1) + (n1 - DNITotal)
If DNITotal > n1 Then DNI(n2) = DNI(n2) + (n1 - DNITotal)
は、分配数を四捨五入して出していますので分配数の合計が個数を上回ったり、下回ったりすることがあります。上回ったときは分配数のうち最大の値から差分だけ差し引き、下回ったときは、最小の値に差分を加えています。
あとは、より汎用性を増すならば、Inputboxで「個数」、「人数」、などをマクロの中で入力させたら良いと思います。

Sub bunpai()
Dim DN(), DNI() As Integer, DNT() As Integer
Rows(5).ClearContents
n1 = Cells(3, 2).Value
n2 = Cells(3, 3).Value
SI = Cells(3, 4)
ReDim DN(n2), DNI(n2), DNT(n2)
DNTotal = 0
For i = 1 To n2
DN(i) = Rnd() + SI / n2
DNTotal = DNTotal + DN(i)
Next
For i = 1 To n2
DN(i) = DN(i) / DNTotal
Next
For i = 1 To n2
DNI(i) = Round(DN(i) * n1, 0)
Cells(5, i + 1) = "合計 " & DNI(i)
Next
DNITotal = Application.Sum(DNI)
Cells(5, n2 + 2) = DNITotal
If DNITotal < n1 Then DNI(1) = DNI(1) + (n1 - DNITotal)
If DNITotal > n1 Then DNI(n2) = DNI(n2) + (n1 - DNITotal)
For i = 1 To n2
DNT(i) = Application.Small(DNI, i + 1)
Next
For i = 1 To n2
Cells(5, i + 1) = DNT(i)
Next
DNTTotal = Application.Sum(DNT)
Cells(5, n2 + 2) = "合計 " & DNTTotal
End Sub

良い頭の体操になりました。

お礼

再現結果はメッチャいいです♪

私の知識が乏しいので、内容を100％理解出来ていませんが・・・
勉強させていただきました

(DNI, i + 1)は確かに？ですね

しかし・・・VBA面白いです

回答No.3

merlionXX

No2 merlionXXです。
分配比率の並べ替えを複雑に考えすぎました。
単純にSMALLを使えばもっと簡単にできますね。

Sub test02()
　　Dim myNum(2) As Integer
　　Dim mySep(2) As Variant
　　Dim n As Integer
　　Randomize
　　myNum(0) = Int(10 * Rnd)
　　Do While (1)
　　　　myNum(1) = Int(10 * Rnd)
　　　　If myNum(0) + myNum(1) <= 10 Then Exit Do
　　Loop
　　myNum(2) = 10 - (myNum(0) + myNum(1))
　　For n = 0 To 2
　　　　mySep(n) = Application.Small(myNum, n + 1)
　　Next n
　　MsgBox "A, B, Cは以下の個数で分配:" & vbNewLine & Join(mySep, "個、") & "個"
End Sub

お礼

あっ分かりやすいですね♪

SMALLは思い浮かびませんでした。
良い勉強になります。

『極端な偏り』を薄めるには・・・

VBAは奥が深いです！

回答No.2

merlionXX

ランダムなら0もあり、同数もありですね？
こんなのはどうでしょう？

Sub test01()
　　Dim myNum(2) As Integer
　　Dim n As Integer, j As Integer, k As Integer, x As Integer, msg As String
　　Randomize
　　myNum(0) = Int(10 * Rnd)
　　Do While (1)
　　　　myNum(1) = Int(10 * Rnd)
　　　　If myNum(0) + myNum(1) <= 10 Then Exit Do
　　Loop
　　myNum(2) = 10 - (myNum(0) + myNum(1))
　　For n = 0 To 2
　　　　For j = 2 To n Step -1
　　　　　　If myNum(n) > myNum(j) Then
　　　　　　　　x = myNum(n)
　　　　　　　　myNum(n) = myNum(j)
　　　　　　　　myNum(j) = x
　　　　　　End If
　　　　Next j
　　Next n
　　For k = 0 To 2
　　　　msg = msg & myNum(k) & vbNewLine
　　Next k
　　MsgBox "A, B, Cは以下の分配" & vbNewLine & msg
End Sub

お礼

はい！
0も同数もありです。

なるほどですね～綺麗に出ますね。

極端な偏りをどう調整するか、考えてみます！

ありがとうございます。

回答No.1

KURUMITO

出来れば後ろの分配率が高くなるようにとのことで、しかもランダムに分配とは矛盾があるように思われますが次のようにしてはどうでしょう。
Ａ1セルに10と入力します。
Ａ2セルにはＡ君、Ａ3セルにはＢ君、Ａ4セルにはＣ君のように入力します。
そこでＢ2セルには次の式を入力して例えばＤ2セルまでオートフィルドラッグします。
=RANDBETWEEN(0,1)
Ｂ3セルにも同じ式を入力してＦ3セルまでオートフィルドラッグします。
Ｂ4セルにも同じ式を入力してＪ4セルまでオートフィルドラッグします。
Ｋ1セルには次の式を入力します。
=SUM(K2:K４)
Ｋ2セルには次の式を入力しＫ4セルまでオートフィルドラッグします。
=SUM(B2:J2)
次にＬ2セルには次の式を入力しＬ4セルまでオートフィルドラッグします。

=IF(A2="","",IF(K$1=A$1,SMALL(K$2:K$4,ROW(A1)),""))

Ｆ9キーを押すことでデータが次々に変わりますのでＬ列にデータが表示された時点でＡ君、Ｂ君、Ｃ君の分配が表示されますね。

いろいろ工夫すれば他のことも考えることができますね。

お礼

ありがとうございます。

何故か再現が出来ませんでした。
力不足を憂うかぎりです orz

自分でもこれを元に探ってみます!