エクセルよる数の振り分け・・・

質問

例えば、ここに郵便配達員が10人いるとします。この10人には、それぞれ配達地区を与え仕事をしてもらうことになった。
　ところが、その配達地区は50地区もあり、それぞれ地区ごとで配達数はばらばらです。
　結論としては、この10人に"配達数"が平等になるように配達地区を分けたいのです。
　そこで今、その地区毎の配達数がエクセルにて集計されています。例えば次のように…

　A1　　　　　B1　　　　　C1
地区番号　　地区名　　配達数
(1～50)　　　　　　　　

　～～～～～～～～～～～～～～

　A52　　　　　B52　　　　C52
　空欄　　　　空欄　　　配達数合計
　A53　　　　　B53　　　　C53
　空欄　　　　空欄　　　平均配達数(C51/10人)

　このような場合において、10人平等に担当地区を振り分ける事ってできるのでしょうか？^_^;
もし、よい方法があれば、ぜひそのお知恵をお貸しくださいm(__)m
　ちなみに私、関数は得意なのですが…BVAの知識はほとんどありません。
　皆さん！ぜひ！ぜひ！よろしくお願いします！！
m(__)m

回答No.4

toshi_2000

その実際のデータ（配達数５０件）を教えてほしいのです。
そうでないとソフトの改良する場所が分かりません。
できれば、どういう結果になればいいかも教えてください。

回答No.3

toshi_2000

ソフトのバージョンアップです。（結果を教えてください）
それから、実際のデータと理想的な振り分け結果を教えてください。
Dim suryo(10) As Integer
Dim chiku(10) As String

For I = 1 To 10
suryo(I) = suryo(I) + Cells(52 - I, 3)
chiku(I) = chiku(I) & " " & Cells(52 - I, 2)
Next

GYO = 41

Do Until GYO < 2
SAISHO = suryo(1)
SI = 1
For I = 1 To 10
If SAISHO > suryo(I) Then
SAISHO = suryo(I)
SI = I
End If
Next

suryo(SI) = suryo(SI) + Cells(GYO, 3)
chiku(SI) = chiku(SI) & " " & Cells(GYO, 2)
GYO = GYO - 1
Loop

For I = 1 To 10
Cells(I, 4) = suryo(I)
Cells(I, 5) = chiku(I)
Next

お礼

やっぱり結果は同じでした…
10人それぞれに、5地区が振り分けられる結果となって、配達数にそれぞればらつきがでてしまいます。

配達地区は50あるのですが、地区毎で配達数にばらつきがあり、1300件だったり、200件だったり、時には3～4件だったりするんです。そして、各々地区の配達数を全部足したものが総配達数であり、それを10人で割った数が１人当たりの平均配達数ということになります。
つまり、１人１人が平均配達数になるように、地区を割り振りたいのです…

例えばA列に地区名、B列に配達数が100，500，420，,，
と入っていて、その配達数の合計が20000件です。それを10人で割ると、１人当たり2000件です。
10人それぞれが、約2000件の配達数を持つように、担当地区を振り分けたいのです。

回答No.2

toshi_2000

地区を固定しないマクロを作ってみました。
サンプルで動作確認願います。
Dim suryo(10) As Integer
Dim chiku(10) As String

For i = 2 To 51
allsuryo = allsuryo + Cells(i, 3)
Next
heikin = allsuryo / 10

For i = 1 To 10
suryo(i) = suryo(i) + Cells(52 - i, 3)
chiku(i) = chiku(i) & " " & Cells(52 - i, 2)
Next

gyo = 41

loop1:
i = 10
Do Until suryo(i) < heikin
i = i - 1
Loop
i2 = i
i = 1
Do Until suryo(i) < heikin
i = i + 1
Loop
i1 = i
For i = i2 To i1 Step -1
suryo(i) = suryo(i) + Cells(gyo, 3)
chiku(i) = chiku(i) & " " & Cells(gyo, 2)
gyo = gyo - 1
If gyo = 1 Then GoTo loop2
Next

i = 1
Do Until suryo(i) < heikin
i = i + 1
Loop
i1 = i
i = 10
Do Until suryo(i) < heikin
i = i - 1
Loop
i2 = i
For i = i1 To i2
suryo(i) = suryo(i) + Cells(gyo, 3)
chiku(i) = chiku(i) & " " & Cells(gyo, 2)
gyo = gyo - 1
If gyo = 1 Then GoTo loop2
Next

GoTo loop1

loop2:
For i = 1 To 10
Cells(i, 4) = suryo(i)
Cells(i, 5) = chiku(i)
Next

お礼

確かにエラーなしで実行されるのですが、結果として地区数が一人5地区に振り分けられるみたいです。
　そのためうまく配達数が、平等(平均)に振り分けられないようです…^^;
　生意気言ってすみませんm(__)mやっぱり、この振り分けは簡単ではないんですね(~_~)

回答No.1

toshi_2000

マクロ（ＶＢＡ）でやればできます。
どれほど平等にするのでしょうか。
一人当たり５地区固定と考えていいのでしょうか。
それとも固定しないのでしょうか。
５地区固定で配達数でソートされている前提で作ったマクロが下記です。
Dim suryo(10) As Integer
Dim chiku(10) As String
For i = 1 To 10
suryo(i) = suryo(i) + Cells(52 - i, 3)
chiku(i) = chiku(i) & " " & Cells(52 - i, 2)
Next

For i = 1 To 10
suryo(i) = suryo(i) + Cells(31 + i, 3)
chiku(i) = chiku(i) & " " & Cells(31 + i, 2)
Next

For i = 1 To 10
suryo(i) = suryo(i) + Cells(32 - i, 3)
chiku(i) = chiku(i) & " " & Cells(32 - i, 2)
Next

For i = 1 To 10
suryo(i) = suryo(i) + Cells(11 + i, 3)
chiku(i) = chiku(i) & " " & Cells(11 + i, 2)
Next

For i = 1 To 10
suryo(i) = suryo(i) + Cells(12 - i, 3)
chiku(i) = chiku(i) & " " & Cells(12 - i, 2)
Next

For i = 1 To 10
Cells(i, 4) = suryo(i)
Cells(i, 5) = chiku(i)
Next

お礼

うわぁ～ほんとにありがとうございます!!!!
ほんとに助かります!!

一人当たり５地区固定ではなくて、あくまでも配達数のみを平等にできればと考えいてます。ですから、一人当たりの地区数は関係ないのです。

もしよろしければ、地区を固定してないVBAを教えて頂けないでしょうか？ぜひ！ぜひ！よろしくお願いします!!