組み合わせ計算について

質問

従業員のスキルポイントごとに業務によって人数を調整できるよう、エクセルで値を求められるか作業を行っていますが、全く手詰まりになっています。

もとはこのようなデータです。
(ゆがんで見にくかったらごめんなさい）

　　業務A　業務B　業務C
--|---------------------
A |　0.5　　1.0　　*
B |　*　　　0.5　　1.0
C |　1.0　　0.3　　0.3
D |　0.3　　1.0　　0.5
E |　1.0　　*　　　0.5

・A,B,C,D.Eのスキルの度合いが1.0,0.5,0.3、スキルなし(*)で数値化されています。

・業務Aには2.2、業務Bには2.1、業務Cには1.8のスキル合計が必要です。

個々のスキルの組合せ合計値>=業務に必要なスキル合計値

で、数値をだしたいです。それぞれの業務に必要な頭数の組み合わせを算出する方法はありますでしょうか？

また、参考までにお聞きしたいのですが、業務に応じて必要なスキル合計値がランダムに変化していく場合があるので、それに合うような組み合わせを算出できる方法は難しいでしょうか？

ご教授のほど、よろしくお願いします。

回答No.2

matsu_jun · ベストアンサー

No1のmatsu_junです。遅くなりましたが作ってみました。
以下のマクロを実行すると、業務の数だけ新しいシートが作られて、そこに結果が格納されます。
(業務の種類が例えば業務Aから業務Dまで4種類あったとすると、「Result1」シートから
「Result4」シートまで、計4枚のシートが作成され、それぞれに格納されます)
出来上がったシートをそのままにして再実行しても、結果シートの中身をクリアした上で
結果を書き直すので、一々結果シートを消す必要はありませんが、
マクロはもともとのデータシートを表示させた上で実行してください。

それぞれのシートの一番上の行に色々なデータを記載しています。
・業務名
・その業務に必要なスキル
・計算結果としての合計スキル
・その結果になる組み合わせの合計個数

2行目から、必要スキルに最も近い取り出しパターンを1行ずつ箇条書きします。
当然何パターンもありえますので、1行ずつ書いていきます。
ためしに20人、業務を3種類ほど適当に作成して実行したところ、20秒くらいかかりました。
(Pentium M 750MHz、Windows Xp SP2、Excel2002にて)
業務が増えれば正比例的に処理時間が増えます(つまり6業種だと約40秒、9業種だと1分・・・)
人数が1人増えれば処理時間が約2倍に増えます(2人増えると4倍、3人増えると8倍・・・)

下の「ここから」の行から、「ここまで」の行を貼り付けて実行してください。

'ここから-----------------------------------------------------------------------------
Sub 組合せ計算()
　　Application.ScreenUpdating = False
　　On Error GoTo ERRHND

'変数定義-------------------------------------------------------------------
　　Dim 結果表示シート名 As String
　　Dim ResultRow As Long
　　Dim ResultCol As Integer
　　Dim TotalMan As Double　　　'人間のトータル
　　Dim TotalGyo As Integer　　 '業務のトータル
　　Dim DatSht As Worksheet
　　Dim DataVal() As Double　　 'データ格納配列
　　Dim DataNam() As String　　 'データラベル格納配列
　　Dim DataSel() As Boolean　　'データ利用有無配列
　　Dim Fws As Boolean　　　　　'シート有無フラグ
　　Dim TgtVal As Double　　　　'目標値
　　Dim TgtWid As Double　　　　'目標値との差
'変数初期値-----------------------------------------------------------------
　　ResultRow = 2
　　ResultCol = 1

'ユーザー定義(この下の行を自由に変更できます)-------------------------------

　　結果表示シート名 = "Result"

'ここまで-------------------------------------------------------------------

　　Set DatSht = ActiveSheet　　'元シート取得
　　TotalMan = Cells(65536, 1).End(xlUp).Row - 2
　　TotalGyo = Cells(1, 256).End(xlToLeft).Column - 1

　　For i# = 1 To TotalGyo
　　　　'結果格納シートの有無チェックと作成
　　　　ShNam$ = 結果表示シート名 & CStr(i)
　　　　Fws = False
　　　　For Each ws In Worksheets
　　　　　　If ws.Name = ShNam Then
　　　　　　　　Fws = True
　　　　　　　　Exit For
　　　　　　End If
　　　　Next ws
　　　　If Fws = False Then
　　　　　　Worksheets.Add After:=Worksheets(Worksheets.Count)
　　　　　　Worksheets(Worksheets.Count).Name = ShNam
　　　　Else
　　　　　　Worksheets(ShNam).Range("A1:IV65536").Clear
　　　　End If

　　　　'目標値のない場合は処理を省略
　　　　If Not IsNumeric(DatSht.Cells(2, i + 1)) Then GoTo CLRSTEP
　　　　If DatSht.Cells(2, i + 1) = 0 Or DatSht.Cells(2, i + 1) = Empty Then GoTo CLRSTEP

　　　　TgtVal = DatSht.Cells(2, i + 1)
　　　　TgtWid = TgtVal

　　　　'配列の作成
　　　　j# = Application.WorksheetFunction.Count(Range(DatSht.Cells(3, i + 1), _
　　　　 DatSht.Cells(TotalMan + 2, i + 1)))
　　　　ReDim DataVal(j)
　　　　ReDim DataNam(j)
　　　　ReDim DataSel(j)

　　　　l# = 1
　　　　For k# = 1 To TotalMan
　　　　　　If IsNumeric(DatSht.Cells(k + 2, i + 1)) Then
　　　　　　　　DataVal(l) = DatSht.Cells(k + 2, i + 1).Value
　　　　　　　　DataNam(l) = DatSht.Cells(k + 2, 1).Value
　　　　　　　　l = l + 1
　　　　　　End If
　　　　Next k

　　　　For k = 2 ^ (j) - 1 To 0 Step -1
　　　　　　m# = 0
　　　　　　n# = k
　　　　　　For l = 1 To j
　　　　　　　　DataSel(l) = n Mod 2
　　　　　　　　n = n \ 2
　　　　　　　　m = m + DataVal(l) * DataSel(l) * (-1)
　　　　　　Next l
　　　　　　If TgtWid >= Abs(TgtVal - m) And TgtVal - m <= 0 Then
　　　　　　　　If TgtWid > Abs(TgtVal - m) Then　　'最近値が更新された場合
　　　　　　　　　　Worksheets(ShNam).Range("A1:IV65536").Clear
　　　　　　　　　　ResultRow = 2
　　　　　　　　　　Worksheets(ShNam).Cells(1, 6) = m
　　　　　　　　　　TgtWid = Abs(TgtVal - m)
　　　　　　　　End If
　　　　　　　　ResultCol = 1
　　　　　　　　For o# = 1 To j
　　　　　　　　　　If DataSel(o) Then
　　　　　　　　　　　　Worksheets(ShNam).Cells(ResultRow, ResultCol) = DataNam(o)
　　　　　　　　　　　　ResultCol = ResultCol + 1
　　　　　　　　　　End If
　　　　　　　　Next o
　　　　　　　　ResultRow = ResultRow + 1
　　　　　　End If
　　　　Next k

　　　　Worksheets(ShNam).Cells(1, 1) = "業務名"
　　　　Worksheets(ShNam).Cells(1, 2) = DatSht.Cells(1, i + 1)
　　　　Worksheets(ShNam).Cells(1, 3) = "必要スキル"
　　　　Worksheets(ShNam).Cells(1, 4) = DatSht.Cells(2, i + 1)
　　　　Worksheets(ShNam).Cells(1, 5) = "合計スキル"
　　　　Worksheets(ShNam).Cells(1, 7) = "組合合計"
　　　　Worksheets(ShNam).Cells(1, 8) = ResultRow - 2 & "組"
CLRSTEP:
　　Next i
ERRHND:
　　DatSht.Activate
　　Application.ScreenUpdating = True
End Sub
'ここまで-----------------------------------------------------------------------------

上の貼り付け方が分からない場合は、以下ご覧下さい。
1) ツール(T)－マクロ(M)－新しいマクロの記録(R)を開く
2) 「マクロの記録」ウィンドウが表示されたら、OKをクリック
3) 画面上に二つのボタンが表示されたツールバーが現れたら、左側の「■」をクリックして記録終了
4) Altキーを押しながらF8キーを押して、マクロウィンドウを開く
5) マクロ名(M)から「Macro1」を選び、編集(E)ボタンをクリック
6) 現れた「Microsoft Visual Basic」の右側に
Sub Macro1()
'
'
'
End Sub
と書いてある部分を削除した上で、上の「ここから」から「ここまで」を貼り付ける　

応用)
結果格納のシート名は基本的には「Result(追番)」ですが、この「Result」は自由に変更できます。
コード中の
　　結果表示シート名 = "Result"
の部分の"　"で囲まれた部分は自由に変更してください。好きな名前のシート名になります。

お礼

できました！！悪戦苦闘しましたがなんとか形になったようです。CGIやタグのようなんですね。ちょっと面白かったのでこれから勉強やろうかな、なんて思っています。

このたびは本当にありがとうございました！！

補足

お休み中なのに本当にありがとうございます！
(実はあの後本に目を通したりしましたが
一朝一夕でわかるものでもなく、
ひそかにお返事をいただけるのを待っていました…)

離れた地域の支店にいる同僚と二人でシートを作成中ですが、
明日には顔をつき合わせて作業に取り掛かれるので
お教えいただいたようにやってみながら
結果をご報告差し上げたいと思います。
がんばって挑戦してみます！

明日には改めて御礼を書き込めるかと思います。
取り急ぎ簡単なお礼まで・・・。

回答No.1

matsu_jun

以下の補足に対する回答次第では私程度のスキルでも、マクロで解決できます。
この手の問題は袋詰問題といいまして、色々な解決法があります。

補足要求)
1) まず、Officeのバージョンはいくつでしょうか？
2) 業務Aに必要な人員、業務Bに必要な人員、業務Cに必要な人員を別々に求めるのですか？
　 それともAさんを業務○へ、Bさんを業務□へ・・・と割り振れば3つの業務全てが
　 並行して進められる、という組合せを求めたいのですか？
　 (plztksさんの例では後者となる状況はありえないのですが)
3) 2)で前者の場合、個々のスキルの合計>=業務に必要なスキル合計である組合せについて
　 全てを知りたいのですか？それともギリギリの組合せについてのみ知りたいですか？
4) 例えばAさんが業務Cを、Bさんが業務Aをといったように、スキルなしの人が
　 その業務を行うというのはアリですか？
5) 現在シートの2行目にはAさんのスキル一覧が書かれていますが、これを1行下げて
　 2行目にはそれぞれの業務の必要なスキル合計を記載するという形は取れますか？
　 (つまりセルB2に「2.2」、C2に「2.1」、D2に「1.8」を記載する)
6) 業務の種類はplztksさんの例では3種類になっていますが、実際のところ何種類ありますか？
　 また、人員は5人になっていますが、実際のところ何人くらいいますか？
　 どちらの回答もおおよそで結構ですし、場合によって増減するというのも構いませんが
　 おおよその数を教えてください。
　 (ただし人員が20人を超えると私のスキルでは普通に利用できる範囲を超えてしまうものしか
　 作れませんが・・・)
7) できるだけ丁寧に解説するつもりではありますが、マクロは利用できますでしょうか？
　 使ったことが無いということであれば解説いたしますし、使ってはいけないということであれば
　 回答をあきらめますので。

補足

matsu_junさん、早速の書き込みありがとうございました。
以下質問の返答です。

1)Office 2000を使用しています

2)最終的には後者の「いろいろなパターンの組み合わせで見ることができる」ほうが望ましいらしいのですが、とり急ぎ前者の個別表示(算出)で大丈夫とのことです。

3)業務別の合計値「以上」のなるべく近い値での組み合わせを算出したいです。未満は算出対象外、ということで。。。

4)スキル無しの方が業務に入ることはナシでお願いします。

5)記述の形式に関しては全く指定がないので、行の挿入などは全然OKです

6)業務の種類・・・50前後
　人数・・・200人前後
が、最終的に作り上げなければいけない数です。今は
業務の種類・・・20
人数・・・20
でお伺いしている作成中のデータ一覧を稼働させることができれば・・・と思っています。

7)今まで本にざっと目を通しただけで全くの初心者と同じだと思って頂いて差し支えありませんが、もしご教授いただけるのでしたらがんばって一歩を踏み出そうと思っています。

以上、どうぞよろしくお願いします!!