[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAで上から順に数値の合計がなるべく均等になるように振り分けたい』（ななな）
表題の通りなのですが、以下のような数値がA列に入力されていたとします。 36 27 46 15 2 35 47 19 33 17 22 29
例えばこれを5つに、各合計がなるべく均等に、上から順に振り分けしたいのですがどうしたらいいでしょうか？VBAでやりたいです。
多分下記が正解になるように思うのですが・・。 36 A 27 A 46 B 15 B 2 B 35 C 47 C 19 D 33 D 17 E 22 E 29 E
＜ 使用 Excel：Excel2016、使用 OS：Windows10 ＞
コメントありがとうございます。 例示の場合、合計値は328となり5つに振り分けたいので平均は65.6になります。 上から順に65.6に近くなるように取っていくと A 63 B 63 C 82 D 52 E 68 となり最大値と最小値の差が一番小さくなると思うのですが、 VBAでやろうとするとどう組んでいいのかわかりません。 （ななな） 2022/08/31(水) 09:43
こう言うのは、現物がどんなものか分からないと、 アカデミック(何でも来いベース）にやることになりますが、無駄骨です。
実際に近いデータを示してください。方策を考えるのはその後です。
（半平太） 2022/08/31(水) 09:51
数値は現物のままです。 作業を行う件数を示しており、これを作業員に割り振るためになるべく均等に振り分けたいのです。 作業の効率の問題でで飛び飛びには作業せず、上から順にこなしていく感じになります。 （ななな） 2022/08/31(水) 10:01
＞ 数値は現物のままです そうですか。
グループ数(5)をB1に手入力する。
<実行後結果図> 行 _A_ _B_ _C_ 1 36 5 A 2 27 A 3 46 B 4 15 B 5 2 B 6 35 C 7 47 C 8 19 D 9 33 D 10 17 E 11 22 E 12 29 E
Sub destritution()
Dim r As Range, aCell As Range, lastCell As Range
Dim itemNum, SumByGroup As Long, AvInRangeLeft, iOut As Long
Dim gLeft As Long, Result(), less As Double, over As Double
Dim Ch As Long
Set r = Range("A1", Cells(500, "A").End(xlUp))
Set lastCell = Cells(r.Rows.Count, "A")
gLeft = Range("B1").Value
itemNum = r.Value
AvInRangeLeft = Application.Sum(Range("A1", lastCell)) / gLeft
ReDim Result(1 To r.Rows.Count, 1 To 1)
Ch = 65
iOut = 0
For Each aCell In r
iOut = iOut + 1
Result(iOut, 1) = Chr(Ch)
SumByGroup = SumByGroup + aCell.Value '同グループ累計を算出
If SumByGroup >= AvInRangeLeft Then '累計が残りの平均以上になった
less = AvInRangeLeft - SumByGroup + aCell.Value '「aCell以前とaCellまでの計」と残りの平均の差を計算する
over = SumByGroup - AvInRangeLeft
If less <= over Then 'aCellを先頭に据える
SumByGroup = aCell.Value
Result(iOut, 1) = Chr(Ch + 1) 'aCellには次のグループ名をセットする
AvInRangeLeft = Application.Sum(Range(aCell, lastCell)) / (gLeft - 1)
Else
If gLeft > 1 Then
SumByGroup = 0 'aCellの次を先頭にする
AvInRangeLeft = Application.Sum(Range(aCell.Offset(1), lastCell)) / (gLeft - 1)
Else
Exit For
End If
End If
Ch = Ch + 1 '次のサイクルの諸元をセットする
gLeft = gLeft - 1
End If
Next
Range("C1").Resize(r.Rows.Count) = Result
End Sub
（半平太） 2022/08/31(水) 12:49
半平太さん、コードまでご提示いただきありがとうございます！ 結果は完璧でした！
マクロ初心者なのでまだまだ分からないところだらけですが、勉強させていただきたいと思います。 （ななな） 2022/08/31(水) 14:13
件数50の場合
1 36 A
2 27 B
3 46 C
4 15 D
5 2 D
6 35 E
7 47 F
8 19 G
9 33 H
件数70の場合
1 36 A
2 27 A
3 46 B
4 15 B
5 2 B
6 35 C
7 47 D
8 19 D
9 33 E
（もんぞう） 2022/09/02(金) 08:06
＞今回のは作業員の人数を指定してなるべく均等に振り分けるものだと思います。 いえ、作業工数の累計をなるべく均等になる様にグループ分けするものです。
＞これを作業員ではなく最大件数を指定して均等に振り分けることは可能でしょうか？ サンプルを見る限り、最大件数を越えない様に先頭からグループ分けするものじゃないですか？ そうだとすると、こっちの方がずーっと簡単だと思われます。
＞12行あった件数は9行に変更お願いします。 解法は、特に12行に限ったものではありません。 A列にあるデータを全て対象にします。
＞実際はAccessで運用してるのですが板違いになりますよね。 ここが分からないです。 対象(9個）は、どこからどうセットするんですか？ エクセルとはまったく別の環境で作業する話なんですか？ それとも、エクセルに手入力なり、コピペなりで数値を入力してからスタートする話なのですか？
（半平太） 2022/09/02(金) 08:54
件数70の場合
1 36 A
2 27 A
3 46 B
4 15 C
5 2 C
6 35 C
7 47 D
8 19 E
9 33 E
物流でのピッキング作業の運用にこのようなものを使ってます。
A列にあるデータが通路、件数が出荷件数だと思って下さい。
Accessに関してですが簡単に説明します。
ODBCリンクしてるテーブルがあります。
テーブルには複数のフィールがあり、そこからクエリで加工してフォームからレポートで紙に印刷してます。
現状は紙に印刷した後に頭で考えて一定の件数を基準に振り分けてから作業員にピッキングを渡してます。
指定件数は状況に応じで変わります。
クエリの加工の過程のなかでこのVBAを使えるのが理想ですが、一度エクセルに落とし込んで使えたらなと思ってます。
（もんぞう） 2022/09/02(金) 09:57
この一つが店舗Aだと思って下さい。
（もんぞう） 2022/09/02(金) 10:13
＞これを作業員ではなく最大件数を指定して均等に振り分けることは可能でしょうか？
ふーむ、その概念が解らないです。
作業員は何人になってもいいのですか？
でしたら、9人にして、A〜I まで割り当てたらいいと思うんですけど。
多分、そうじゃないのでしょうね。 作業員総数、件数合計、最大件数の相互関係について、何か説明してないことってありませんか？
（半平太） 2022/09/02(金) 11:18
取り敢えず、焼き直しで作ってみました。
最大件数は、D2セルに入力してください。
<結果図> 行 ____A____ ____B____ ___C___ ____D____ 1 作業通路 出荷件数 作業員 最大件数 2 1 36 作業員A 50 ←D2セルは手入力(70とか） 3 2 27 作業員B 4 3 46 作業員C 5 4 15 作業員D 6 5 2 作業員D 7 6 35 作業員E 8 7 47 作業員F 9 8 19 作業員G 10 9 33 作業員H
Sub destribution()
Dim r As Range, aCell As Range, lastCell As Range
Dim itemNum, SumByGroup As Long, AvInRangeLeft, iOut As Long
Dim gLeft As Long, gLeftStart As Long
Dim Result(), less As Double, over As Double
Dim Ch As Long
Dim i, cMax As Long, maxSofar As Long
Set lastCell = Cells(Rows.Count, "B").End(xlUp)
Set r = Range("B2", lastCell)
cMax = Range("D2").Value
If Application.Max(r) > cMax Then
MsgBox "不可能です"
Exit Sub
End If
itemNum = r.Value
gLeftStart = Int(Application.Sum(r) / cMax)
AvInRangeLeft = Application.Sum(r) / gLeftStart
For i = gLeftStart To gLeftStart + r.Rows.Count
gLeft = i
ReDim Result(1 To r.Rows.Count, 1 To 1)
maxSofar = 0
Ch = 65
iOut = 0
SumByGroup = 0
For Each aCell In r
iOut = iOut + 1
Result(iOut, 1) = "作業員" & Chr(Ch)
SumByGroup = SumByGroup + aCell.Value '同グループ累計を算出
If SumByGroup >= AvInRangeLeft Then '累計が残りの平均以上になった
less = AvInRangeLeft - SumByGroup + aCell.Value '「aCell以前とaCellまでの計」と残りの平均の差を計算する
over = SumByGroup - AvInRangeLeft
If less <= over Then 'aCellを先頭に据える
maxSofar = Application.Max(maxSofar, SumByGroup - aCell.Value) '最大値を更新
SumByGroup = aCell.Value
Result(iOut, 1) = "作業員" & Chr(Ch + 1) 'aCellには次のグループ名をセットする
AvInRangeLeft = Application.Sum(Range(aCell, lastCell)) / (gLeft - 1)
Else
If gLeft > 1 Then 'aCellの次を先頭にする
maxSofar = Application.Max(maxSofar, SumByGroup) '最大値を更新
SumByGroup = 0
AvInRangeLeft = Application.Sum(Range(aCell.Offset(1), lastCell)) / (gLeft - 1)
Else
Exit For
End If
End If
Ch = Ch + 1 '次のサイクルの諸元をセットする
gLeft = gLeft - 1
End If
Next
If maxSofar <= cMax Then
Range("C2").Resize(r.Rows.Count) = Result
Exit For
End If
Next i
End Sub
（半平太） 2022/09/02(金) 13:15
ピッキング作業の話になるのですが、ピッキングを置いてる場所から出荷する通路までの距離が多少あります。
9人にしてA〜I まで割り当てた場合、1人あたりの件数が少ないとその分の距離が無駄になります。
出荷作業の流れとして一番いいのは1人で1〜9までするのがいいです。
ただそのあとの出荷した物の移動、出荷した物の検品など次の作業の効率が悪くなります(細かい説明は省略します)。
件数に応じて人数を変化させたいと思ってます。
最大件数を50に設定した場合、1〜9までの合計件数が50以下の場合は作業人数は1人となります。
1〜9までの通路も必ず全てあるわけではなく、1の通路が件数1のみの場合もあります。
1〜9までの通路で1店舗でそれが1日に500店舗ぐらいあります。
（もんぞう） 2022/09/02(金) 13:34
＞1〜9までの通路で1店舗でそれが1日に500店舗ぐらいあります。
そう言う状態の話の場合、 最低でももう1店舗(計2店舗)のサンプルがどうなっているのか 説明いただかないと拡張性を考慮できないです。
上記プロシージャは、A列に入っているデータは全て1店舗として処理しております。
（半平太） 2022/09/02(金) 13:44
A列に入っているデータは全て1店舗で問題ないです。
D2セルに手入力する最大件数以上の出荷件数がある場合がエラーになります。
いろいろと説明不足申し訳ございません。
（もんぞう） 2022/09/02(金) 14:12
＞D2セルに手入力する最大件数以上の出荷件数がある場合がエラーになります。
また、少しわからなくなったのですが、 そういう場合はどう処理するのが正しいのですか？
＞通路1〜9は必ず全てがあるわけではありません。 ＞1通路の件数は0〜999ぐらいです。 ＞最大件数以上の件数がある場合もあります
その条件全てを満足させるサンプルを提示いただけないですか？(正解つきで）
（半平太） 2022/09/02(金) 14:36
通路1〜9の件数が全て1の場合
最大件数が9以上ならば作業員は1人
最大件数が1ならば作業員は9人
最大件数が5ならば作業員は2人
通路1の件数が1で他が0の場合
最大件数が9以上ならば作業員は1人
最大件数が1ならば作業員は1人
最大件数が5ならば作業員は1人
このような感じでわかるでしょうか？
（もんぞう） 2022/09/02(金) 14:48
なるほどです。
それで、この点はどうなんですか？ ↓ ＞ ＞D2セルに手入力する最大件数以上の出荷件数がある場合がエラーになります。 ＞ そういう場合はどう処理するのが正しいのですか？
極端な話、通路1〜9の件数が全て2で最大件数が1の場合
（半平太） 2022/09/02(金) 16:30
（もんぞう） 2022/09/02(金) 16:37
ふーむ、最大件数の持つ意味について、頭を再整理しないとならないです。
すこし、時間が必要です。気長にお待ちください。
※その前にどなたかがやってくれるといいですが・・
（半平太） 2022/09/02(金) 16:50
別の方が立てたスレッドが長くなってしまってますので一旦私の質問は終わりで大丈夫です。
人数で均等に振り分ける→最大件数で均等に振り分ける
に応用できるかと思い質問させていただきました。
理想はAccessでの運用ですので一度Accessのほうの掲示板を探して質問したいと思います。
お手数おかけしました。
本当にありがとうございます。
（もんぞう） 2022/09/02(金) 17:11
何か、しどろもどろになってしまった。
前回と同じ様に、最大件数はD2セルに入力してください。 マクロ名は「Trial」です。
’--------------------------------------------------------
Private r As Range, lastCell As Range, cMax As Long Private Result(), Manage(), Judge()
Sub destribution()
Dim i As Long, fixed As Long
Range("C2:C100").ClearContents
Set lastCell = Cells(Rows.Count, "B").End(xlUp)
Set r = Range("B2", lastCell)
cMax = Range("D2").Value
ReDim Judge(1 To r.Rows.Count, 1 To 1) '超量総計*10000+超個*100+作業員数
' For i = 9 To r.Rows.Count '作業員数
For i = 1 To r.Rows.Count '作業員数
figureOutByDriver i
Next i
Call figureOutByDriver(Application.Min(Judge) Mod 100)
Range("C2").Resize(UBound(Result)) = Result
End Sub
Private Sub figureOutByDriver(i As Long)
Dim crrPics As Range
Dim SumByDriver As Long, AvInRangeLeft
Dim drLeft As Long, Ch As Long
Dim less As Double, over As Double
Dim iOut As Long
Dim maxExcessSUM As Double
Dim compKey As Variant
ReDim Result(1 To r.Rows.Count, 1 To 1)
ReDim Manage(1 To r.Rows.Count, 1 To 3) '超量総計、Max超個、作業員数
drLeft = i
AvInRangeLeft = Application.Sum(r) / drLeft
Ch = 65
SumByDriver = 0
For iOut = 1 To r.Rows.Count + 1
Set crrPics = r(iOut, 1)
If crrPics > 0 Then
Result(iOut, 1) = "作業員" & Chr(Ch)
SumByDriver = SumByDriver + crrPics '同グループ累計を算出
If SumByDriver >= AvInRangeLeft Then '累計が残りの平均以上になった
less = AvInRangeLeft - SumByDriver + crrPics '残平均との差を計算する
over = SumByDriver - AvInRangeLeft
If (less <= over) Or (SumByDriver > cMax) Then 'crrPics を先頭に据える
If iOut > 1 Then
Manage(iOut - 1, 1) = SumByDriver - crrPics > cMax
maxExcessSUM = maxExcessSUM + Application.Max(0, SumByDriver - crrPics - cMax)
Manage(1, 2) = IIf(Manage(iOut - 1, 1), 1, 0) + Manage(1, 2)
Manage(1, 3) = i
SumByDriver = crrPics
Result(iOut, 1) = "作業員" & Chr(Ch + 1) 'crrPics には次のグループ名をセットする
If drLeft > 1 Then
AvInRangeLeft = Application.Sum(Range(crrPics, lastCell)) / (drLeft - 1)
End If
Else
Manage(iOut, 1) = SumByDriver > cMax
maxExcessSUM = maxExcessSUM + Application.Max(0, SumByDriver - cMax)
Manage(1, 2) = IIf(Manage(iOut, 1), 1, 0) + Manage(1, 2)
Manage(1, 3) = i
SumByDriver = 0
Result(iOut, 1) = "作業員" & Chr(Ch) 'crrPics には次のグループ名をセットする
If drLeft > 1 Then
AvInRangeLeft = Application.Sum(Range(crrPics, lastCell)) / (drLeft - 1)
End If
SumByDriver = 0
End If
Else
If drLeft > 0 Then ' crrPicsの次を先頭にする
Manage(iOut, 1) = SumByDriver > cMax
maxExcessSUM = maxExcessSUM + Application.Max(0, SumByDriver - cMax)
Manage(1, 2) = IIf(Manage(iOut, 1), 1, 0) + Manage(1, 2)
Manage(1, 3) = i
SumByDriver = 0
If drLeft > 1 Then
AvInRangeLeft = Application.Sum(Range(r(iOut + 1, 1), lastCell)) / (drLeft - 1)
End If
Else
Exit For
End If
End If
Ch = Ch + 1 '次のサイクルの諸元をセットする
drLeft = drLeft - 1
End If
End If
Next iOut
compKey = maxExcessSUM * 10000 + Manage(1, 2) * 100 + Manage(1, 3)
Judge(i, 1) = IIf(compKey, compKey, Empty)
End Sub
（半平太） 2022/09/02(金) 23:58 →優先ロジック修正 2022/09/03(土) 23：10
1 50 A
2 40 B
3 30 C
4 50 D
5 70 E
6 20 F
7 10 F
8 50 G
9 10 G ×I
最大件数40
1 40 A
2 50 B
3 30 C
4 70 D
5 70 E
6 20 F
7 50 F ×G
8 10 G ×H
9 20 G ×H
最大件数40
イメージ通りの物になりました。
ありがとうございます。
（もんぞう） 2022/09/03(土) 08:24
なるほどです。 他に70個出荷している人がいるんだから、そこまではいいじゃないか、 と言うロジックにしてしまった。
優先順位を以下に修正します。(超過数量の合計を少なくできるなら、人を増やす) ＞ 超量*10000+超個*100+作業員数 ↓ 超量総計*10000+超個*100+作業員数
昨夜(2022/09/02(金) 23:58）アップしたコードを上書き修正しましたので、 再トライしてみてください。
（半平太） 2022/09/03(土) 10:05
最大件数30
1 41 A
2 33 B
3 36 C
4 13 D
5 25 D ×E
6 18 E ×F
7 39 F ×G
8 54 G ×H
9 9 H ×I
（もんぞう） 2022/09/03(土) 13:29
ウーム、私のロジックではどうしようもないです。
9人を前提とすると、4番目以降については残り6人で平均で26.3個の出荷となります。
1人目の13個だけにした場合、平均に対して、13.3個の乖離があります。一方 2人目の25個を含めても、平均に対して、11.7個の乖離しかありません(絶対値ベース)。
なので、乖離の少ない2人を採用せざるを得ず、その時点で最多でも8人構成になってしまいます。
まぁ、数が少ないので、総当たりでシミュレーションする方式でも何とかなりそうな気がしますけど、 私はここまでとさせていただきます。お役に立てず申し訳ないです。
※長くなったので、新規にトピを立てた方が参加者が増えるかと思います。
（半平太） 2022/09/03(土) 14:50
何かありましたら新規でスレッドを立てます。
たくさんの書き込みありがとうございます。
（もんぞう） 2022/09/03(土) 15:38
＞2人目の25個を含めても、平均に対して、11.7個の乖離しかありません(絶対値ベース)。
ここに一考の余地がありました。m(__)m
いくら乖離が小さくとも、それで最大件数を越える様なら、 多い方(2人にする）は止めて置くと言う修正は出来そう。
まだ、見ているのであれば、やってみますけど。。 (見てないなら、無駄なことはしない主義なので）
（半平太） 2022/09/03(土) 16:06
やってみましたが(前回のものを上書き修正済み) ただ、今度は以前のケースが合わなくなりますね。
件数70の場合 → 通路 件数 作業員 1 36 A │ 1 36 作業員A 2 27 A │ 2 27 作業員A 3 46 B │ 3 46 作業員B 4 15 C │ 4 15 作業員B 5 2 C │ 5 2 作業員B 6 35 C │ 6 35 作業員C 7 47 D │ 7 47 作業員D 8 19 E │ 8 19 作業員D 9 33 E │ 9 33 作業員E
今回はここまでにします。
新たにトピを立ててください。 参加者が増えるでしょうし、別案も浮かぶかも知れません。
（半平太） 2022/09/03(土) 23:10
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.