こんな問題、VBAで解けますか？

質問

ひとグループ何人か？
x人をグループ分けする。
ただし、以下のような条件がある。
・番号が小さいグループが、大きい番号のグループより、人数が少なくなることはない。
・グループの最大数は10である。
・1グループの最大人数は40人で、最小は32である。
・グループあたりの人数は極力少なくする。
関数名/GROUP　引数/人数　戻値/ひとつのグループの人数
どのように問題を整理してプログラム化していけばよいのでしょうか？

回答No.5

nekoron07 · ベストアンサー

No.2です。細かい設定はとりあえず無視して計算してみます。
まずはVBAを使わないで計算する方法。
　　　A　　　B
1　386　　　　　　　　　←A1:x値の入力箇所
2　　1　　=IF(INT(($A$1-SUM(B3:$B$11))/A2)<32,0,INT(($A$1-SUM(B3:$B$11))/A2))
3　　2　　↓B2の内容をB10までコピー
4　　3　　〃
5　　4　　〃
6　　5　　〃
7　　6　　〃　
8　　7　　〃
9　　8　　〃
10　　9　　〃
11 　10　　=IF(INT($A$1/A11)<32,0,INT($A$1/A11))

次に、同じ計算をVBAでする方法。（かなり長いです。）

Sub グループ人数2()
Dim x
Dim G1, G2, G3, G4, G5, G6, G7, G8, G9, G10
x = Application.InputBox("32～400までの数値(41～63,81～95,121～127を除く）を入力してください。", "x値の入力")
If x <> False Then
If x < 32 Or x > 400 Or (x >= 41 And x <= 63) Or (x >= 81 And x <= 95) Or (x >= 121 And x <= 127) Then
response = MsgBox("数値が範囲外です。")
Else
If Int(x / 10) < 32 Then
G10 = 0
Else
G10 = Int(x / 10)
End If
If Int((x - G10) / 9) < 32 Then
G9 = 0
Else
G9 = Int((x - G10) / 9)
End If
If Int((x - G10 - G9) / 8) < 32 Then
G8 = 0
Else
G8 = Int((x - G10 - G9) / 8)
End If
If Int((x - G10 - G9 - G8) / 7) < 32 Then
G7 = 0
Else
G7 = Int((x - G10 - G9 - G8) / 7)
End If
If Int((x - G10 - G9 - G8 - G7) / 6) < 32 Then
G6 = 0
Else
G6 = Int((x - G10 - G9 - G8 - G7) / 6)
End If
If Int((x - G10 - G9 - G8 - G7 - G6) / 5) < 32 Then
G5 = 0
Else
G5 = Int((x - G10 - G9 - G8 - G7 - G6) / 5)
End If
If Int((x - G10 - G9 - G8 - G7 - G6 - G5) / 4) < 32 Then
G4 = 0
Else
G4 = Int((x - G10 - G9 - G8 - G7 - G6 - G5) / 4)
End If
If Int((x - G10 - G9 - G8 - G7 - G6 - G5 - G4) / 3) < 32 Then
G3 = 0
Else
G3 = Int((x - G10 - G9 - G8 - G7 - G6 - G5 - G4) / 3)
End If
If Int((x - G10 - G9 - G8 - G7 - G6 - G5 - G4 - G3) / 2) < 32 Then
G2 = 0
Else
G2 = Int((x - G10 - G9 - G8 - G7 - G6 - G5 - G4 - G3) / 2)
End If
G1 = x - G10 - G9 - G8 - G7 - G6 - G5 - G4 - G3 - G2
response = MsgBox("グループ1：" & G1 & " グループ2：" & G2 & " グループ3：" & G3 & " グループ4：" & G4 & _
" グループ5：" & G5 & " グループ6：" & G6 & " グループ7：" & G7 & " グループ8：" & G8 & " グループ9：" & G9 & " グループ10：" & G10)
End If
End If
End Sub

お礼

ありがとうございます。後半のプログラムでできました！感謝感激雨霰です(^o^)

回答No.7

kazu3298

３番のものです。
　このような設問をするのは学校の先生ではないかなと思っていたのですが、後から答えた方が良かったかな。

回答No.6

KG_

nekoron07さんの仰るとおり、その条件を満たすにはx値に制限が多くなると思います。

x=50とかだとするとGroup1=32～40だとしても、18～10余りますので最小値32を満たさなくなり
Groupを１つ追加するかしないか、じゃあ溢れた人数はどうするかという問題が出てくると思います。

そういう値は除外するのはnekoron07さんがご提示されている通りかと思います。

他に関数を使ってはいけないという条件がなければ
-----------------------------------------------------

Sub Test()
　　Dim cnt As Integer　
　　cnt = CInt(InputBox("32-400までの数を入力"))

　　Dim grps() As Integer
　　grps = GROUP(cnt)

　　Dim rslt As String
　　Dim i As Integer

　　For i = 1 To UBound(grps)
　　　　rslt = rslt & "Group " & CStr(i) & " " & grps(i) & "人" & vbCrLf
　　Next
　　MsgBox rslt
End Sub

Private Function GROUP(ByVal cnt As Integer) As Integer()
　　Dim ret() As Integer
　　ReDim Preserve ret(1 To 1) As Integer
　　ret(1) = 0

　　Dim grpsCnt As Integer
　　Dim afure As Integer
　　Dim i As Integer
　　Dim j As Integer

　　If cnt >= 32 Then
　　　　If cnt <= 400 Then
　　　　　　If ((cnt >= 41 And cnt <= 63) Or (cnt >= 81 And cnt <= 95) Or (cnt >= 121 And cnt <= 127)) = False Then
　　　　　　　　grpsCnt = cnt \ 32
　　　　　　　　afure = cnt Mod 32
　　　　　　　　If afure > 32 Then grpsCnt = grpsCnt + 1

　　　　　　　　If grpsCnt > 10 Then
　　　　　　　　　　For i = 40 To 32 Step -1
　　　　　　　　　　　 If (cnt \ i) = 10 Then
　　　　　　　　　　　　　　grpsCnt = 10
　　　　　　　　　　　　　　afure = cnt Mod i
　　　　　　　　　　　　　　ReDim Preserve ret(1 To 10) As Integer
　　　　　　　　　　　　　　For j = 1 To 10
　　　　　　　　　　　　　　　　ret(j) = i
　　　　　　　　　　　　　　Next
　　　　　　　　　　　　　　Exit For
　　　　　　　　　　　　End If
　　　　　　　　　　Next
　　　　　　　　Else
　　　　　　　　　　ReDim Preserve ret(1 To grpsCnt) As Integer
　　　　　　　　　　For i = 1 To grpsCnt
　　　　　　　　　　　　ret(i) = 32
　　　　　　　　　　Next
　　　　　　　　End If

　　　　　　　　AfureFuriwake ret, grpsCnt, afure
　　　　　　End If
　　　　 End If
　　End If

　　GROUP = ret
End Function

Private Sub AfureFuriwake(ByRef grps() As Integer, grpsCnt As Integer, ByVal afure As Integer)
　　Dim i As Integer
　　Dim add As Integer

　　add = afure \ grpsCnt
　　afure = afure Mod grpsCnt

　　If add > 0 Then
　　　　For i = UBound(grps) To (UBound(grps) - grpsCnt + 1) Step -1
　　　　　　grps(i) = grps(i) + add
　　　　Next
　　End If

　　If afure > 0 Then
　　　　AfureFuriwake grps, grpsCnt - 1, afure
　　End If
End Sub

-----------------------------------------------------
みたいにもできるかと思います。正確にテストしたわけでは
ありませんので、間違ってたらすみません。内容は読んでご理解
いただければと思います。

回答No.4

nekoron07

No.2です。
xが例えば45人の場合はどうするのでしょうか？どうしても半端な人数が残ってしまいますよね？
1グループの最少人数が32人、最大人数が40人という制限があると、ｘ値にかなりの制限が出てくると思います。

補足

nekoron07さんのおっしゃるとおりです。xの値は32～40、64～80、・・・、320～400に制限されることになります!!

回答No.3

kazu3298

人数は出来るだけ均等の方がよいとかの前提はないのでしょうか。
最初のグループに多く割り振っても、良いのですか。

引数/人数は、最少３２で最大４００になるんですよね。入力値の範囲チェックは必要ですね。

戻り値ってそれぞれのグループの人数ではなくてよいのですか。

グループは多い方がいいのでしょうか。少ないほうがいいのでしょうか。
例えば、３２０人の場合は、３２人ずつ１０グループにするのですか。それとも、４０人ずつ、８グループにするのでしょうか。

ロジックを組む上では少し情報が足りないような。
漠然と頭の中にはあるのだと思いますが、それをどうしたいのか整理しないと組むのは難しいですね。

補足

人数はグループ番号の数字が小さいほど少なくします。
戻り値はそれぞれのグループの人数でした！スミマセン。
もし、320人だったら、一グループの人数は極力小さくするので32人×10グループでよいです

回答No.2

nekoron07

すみません、VBAプログラム以前に、この問題、「xの最小値（または範囲）」とか「グループの最少数」は決まってるんですかね？決まっていなければ解きようが無いと思うのですが…。

補足

ありがとうございます。この問題は私が作ったわけではないのですが、グループの最少数は1で、したがって、xの最小値は32ということになるかと思います。

回答No.1

SAYKA

その条件　頭の中で回答できる？
もしできるというのなら　その回答手順を箇条書きにしてごらん。

それが答え。(ごめん　端折りすぎた)