ChatGPTと協力して、タイムテーブル作成における組み合わせ問題の業務改善をすることができた

はじめに

こんにちは、YNです。 こんなこといいな、できたらいいな、と思って頼めばどんな面倒なことも答えてくれるChatGPT。人間の能力を拡張し、世界を変えていく予感はあるものの、この先どうなるんだろう、すごいけど活用方法が判らない、と不安が先行し、なかなか手が伸びない人が多いのではないだろうか。すこし古いレポートだが、野村総合研究所が2015年に発表したレポートで10〜20年後には日本の労働人口の約 49％がAI(人工知能)等で代替可能になる、という試算も出ている。 詳細は下記URLより確認して欲しい。 https://web-camp.io/magazine/wp-content/uploads/2020/10/151202_1.pdf

とはいえ、代替可能性が高い職業とされているものも全てが代替されるわけがなく、AIやロボットのオペレータは必要なわけで、代替可能性が低いとされている職業もChatGPTやお絵描きAIの発展を見ると活用方法はそれなりにあるはずだ。なので、使いこなせた方がいいのは間違いなく、ChatGPTを実際に触ってみるとやっぱり興味深い。そういえば小さい頃、ドラえもんの漫画を読んでいた時に夢見ていた、ロボットが活躍し、共生する世界がもう目の前にあるんだな、と感慨にふけるものだ。

前置きが長くなったが、本記事では、コーディングツールとしてChatGPTを活用し、組み合わせ問題における業務改善で試行錯誤する様子を綴っている。ChatGPTをこれから触ってみようかな、やったほうがいいんだろうけど何からやればいいかな、と迷っている方には、今後のChatGPTの活用方法の参考になるかもしれない。

組み合わせ問題とは？

「組み合わせ問題」という単語はあまり聞かないかもしれないが、これはありふれた問題だ。アルバイト経験がある方なら一度は目にしたことがあるでしょう。店長が来月のシフト表（あるいはタイムテーブル）を作る際に、うーん…と頭を悩ませていたあの瞬間。

穴が開いている時間帯を作らないようにアルバイトさんのシフトを計画していくが、アルバイトさんの希望ベースなので人気、不人気の偏りがどうしてもあり、またそれぞれの希望がそれなりに満たされるよう配慮する必要がある。

ジグソーパズルのように継ぎ接ぎして上手く隙間を埋めたシフトを計画しても、突発的な欠員で、穴が開いてしまうこともあり、再びシフト表と睨めっこしては「○○さん、お願いがあるんだけど～」と、調整を行っている姿を目にした経験はあるかと思う。これは結構、疲れるものである。

背景、課題

弊社でも組み合わせ問題で悩んでいる部署があった。 弊社で請け負っている調査手法に、複数人同時に行うインタビュー形式の調査（以下、グループインタビュー）というものがある。複数人同時に行うことで、他の人の視点に対する共感や気づきを観測することが出来るメリットがあり、この調査を行うためには、いつ、何人に、誰に、参加してもらうか計画したシフトのようなものを作成する必要がある。ここで先ほどの例のように組み合わせ問題が発生する。

また、当該部署では、コア業務とノンコア業務の切り分けを行い、ノンコア業務を単価の安い非熟練作業者への展開を積極的に行うことで熟練作業者の生産性と品質の向上を取り組んでいた。今回のシフト作成も非熟練作業者へ展開したい業務の1つで、熟練作業者でも1回あたり平均1時間程度の工数がかかっており、ヒューマンエラーも多く、効率的でもなかった。業務効率化のため、自動化をしたい、どうすればよいだろうか、と相談があった。

ChatGPTくん～、良い組み合わせ持ってきて～！

そうだ、巷で話題のChatGPT君に頼んだらいけるんじゃないかな？色々頼めばできるらしいし。

いよいよ初めてのChatGPTとの共同作業！

いい感じの組み合わせをお願い！

テスト用データを用意した！

いざ投入！

無理だった

文章生成は得意だから、組み合わせを生成するのは得意かも、との考えはさすがに短絡的だったようだ。それにしても無理なことは無理だと言ってくれるのはすごい。

組み合わせを生成するマクロをChatGPTに作ってもらおう

ChatGPTからの回答にある通り、組み合わせ作成自体を丸投げできないので、組み合わせを行うためのマクロを作成してもらうことにした。 試しに、「いい感じの組み合わせができるマクロを作成して」くらいのざっくりとしたプロンプトを投入してみたが、リストを上から順に処理して組み合わせを作成するような単純なコードしか生成されなかった。流石にそれが最適な組み合わせです、とは言えないので、ちゃんとプロンプトにどのように最適な組み合わせを作成するか要件を盛り込む必要があるようだ。

要件定義

ここからはマクロの要件定義の話に入る。細かい話にはなるので、プロンプトだけ見たい人は「ChatGPTのプロンプト作成」まで読み飛ばして良い。

まず、入力データとなる２種類のテーブルデータを紹介し、組み合わせを作成する制約条件を確認する。

入力データ①　候補者データ

グループインタビュー調査対象の候補者がレコードのテーブルデータ。キーは「no」列。日付の列が「○」になっている候補者は参加可能。「優先順位」とは属性情報やこれまでの参加実績等を考慮した上でグループインタビュー実施者が付与する順位。値が小さいほうに優先度が高い。このデータでは「1」が最優先。

入力データ②　枠人数データ

開催されるグループインタビューごとのテーブルデータ。キーは「id」列。開催日程、開催時刻はグループインタビューが開始される日時。枠数は必要人数。

制約条件

1. グループインタビューの枠数と同じ数の候補者を割り振ること。難しい場合は枠数以下にすること。
2. 1人につき、1つの案件のすべての日時で参加できるグループインタビューは1回のみ
3. 優先順位の高い（値は小さい）候補者から割り振りがされるのが好ましい。優先順位無しの候補者は割り振り対象外。
4. グループインタビューの日時に「○」のない場合は、その日時に候補者の割り振りできない。

では次にベストな組み合わせとは何か？を定義する。

ベストな組み合わせの定義

グループインタビューにどの候補者に参加してもらうか組み合わせを作成するうえで、ベストな組み合わせとは、必要な枠を満たし、かつ全ての候補者の優先順位が「1」となる組み合わせだ。 しかし、あくまで参加の希望ベースなので、枠をすべてを満たす組み合わせが存在しない場合もあることが前提。優先度の高い候補者の数も未知数。

神よ！と祈祷してお願い奉れば、ベストな組み合わせの啓示が下る、

なんてことはないので、地道に組み合わせを何パターンも作成し、比較することでベストな組み合わせを見つける、というのが大まかな作戦。

今回であれば作成した組み合わせを比較するときのポイントは

• 空き枠数が少ない方が良い
• 空き枠数が同数のパターンが複数ある場合、候補者の優先順位の平均が小さい方が良い

となる。

では、具体的な組み合わせの作成の方法を検討する。

プランA　組み合わせを総当たりで作成

ベストな組み合わせを見つけるにあたり、最も直接的な方法として、組み合わせの総当たりを作成して比較する、という方法がまず考えられた。

しかし・・・

どうしても計算量の問題に直面する。 今回は279人の対象者から、グループインタビュー30回×4人=120人の枠を選ぶので、 その組み合わせのパターンの数は、

• 279!÷(279-120)!≒2.03281E+280通り。

280桁！多い！！！

実際は大体１枠につき半分くらいが参加可能なので、単純に279人の半分の140人と仮定しても、

• 140!÷(140-120)!≒5.53331E+222 通り。

222桁！やっぱり多い！！！

脱線(計算量について)

私が悩んでいる様子を見かねた先輩MYさんから「そりゃ無茶だよ」と解説いただいた。大変感謝です！以下、有難い解説。

私が使っている PC に載っている実メモリが 8GB 。 VBA の long 型は 16bit、つまり 2 バイトなので、実メモリを全部使うと、 8GB ÷ 2B ＝ 4G 個 ＝ 4 × 2^30 個 のサイズの配列ができる。 10 進数の桁数を考えるために常用対数を取ると、 log_10 ( 4 × 2^30 ) ＝ log_10 2^32 ＝ 32 × log_10 2 ≒ 32 × 0.3010 ≒ 9.6 つまり 10 桁。

メモリを全部使っても、配列のサイズは 10 進数で 10 桁の個数しか取れない。 一方、必要なサイズの桁数は、280桁。

このアイディアを実現しようとするとスパコンが必要なレベルで、つまり、私に会社から支給されている一般的なスペックのパソコンでは計算量の爆発により不可能！！

以上。

プランB　ヒューリスティックな方法で組み合わせを作成

総当たりを作成するのは計算量の爆発の問題で難しいので、次善の策として、手作業での組み合わせ作成方法を参考に考えていく。これも先輩MYさんからのアドバイス。 手作業でやる場合、最小の手数で、良い組み合わせになる可能性が高い作業フローになっているはず。そこに立ち戻ることで計算量の爆発を回避したうえで、複数パターンの組み合わせを作成する方法を検討する。

手作業では、グループインタビューの回ごとに参加可能な対象者の数を算出して、その数が少ない回から候補者の割り振りを行っているようだった。つまり、参加希望を集計した結果、下記のような結果だったと仮定する。

• 日付：XX月A日　枠数：10人　参加可能：10人
• 日付：XX月B日　枠数：10人　参加可能：20人

この時、A日、B日の両方のグループインタビューに参加可能な候補者が10人いたとすると、Aに参加できる候補者は枠数ギリギリなので、1人でもB日に取られちゃうと欠員が出てしまう。A→Bの順番で候補者割り振りを行うと自然と上手く欠員がでない組み合わせになる、ということになる。

ただ、この手順をトレースした場合、何回やっても同じような組み合わせにしかならないので、大局的にはベストに近い組み合わせが作成できない可能性もある。 これにより、複数パターンを作成するメリットが失われ、結果として、「たまに修正の手間が大きい組み合わせしか出さないよね」みたいなことになりかねない。

そこで、グループインタビューごとに候補者の数から枠数を減算してからランダム値を乗算した値を出し、その値で小さい順にソートするという計算を行う。例えば、

• 日付：XX月A日　枠数：10人　参加可能：10人
• 日付：XX月B日　枠数：10人　参加可能：20人
• 日付：XX月C日　枠数：10人　参加可能：18人

だとすると、

• A日　10-10=0 → 0×ランダム値
• B日　20-10=10 → 10×ランダム値
• C日　18-10=8 → 8×ランダム値

となる。 この時、Aはどんなランダム値を引いても0となるが、引くランダム値によってはB,Cの大小関係は変わるので、A→B→Cの時もあれば、A→C→Bの時もある。ただ、ランダム値を乗算するとしても候補者の少ないCのほうが小さい値になる可能性は高いので、ソートした順番が生成される確率は

• A→C→B　＞　A→B→C

となる。 そのソートした順番で候補者を割り振ることで、参加可能な候補者の数が少ない回から候補者が優先されて割り振られる傾向を保ちつつ、組み合わせを作成することができる。 あとは処理として何回も繰り返し作成することで、組み合わせのバリエーションが増やし、その中から「ベストな組み合わせの定義」の条件に従い、組み合わせを評価し、ベスト（に近い）組み合わせを見つける、というアルゴリズムになる。

ChatGPTのプロンプト作成

プロンプトを投入して、返ってきたコードのメンテナンス性の観点からでレビューし、プロンプトを修正し、再度投入、というのを何回か行った。 ChatGPT強者はドンピシャなコードを生成できるような、すっごいプロンプトを作成できるのかもしれないが、まだ私はChatGPTとの付き合いが浅いので、自分でそれなりに手を加えることを前提にプロンプトの探索は、ある程度のところで留めた。 プロンプトの最終版は下記に記載する。後述する反省も含めて参考にして欲しい。

※今回は課金が不要なGPT-3.5を利用。それぞれの手元でどんなコードが生成されるかぜひ試してみて欲しい。ただし、生成されるコードはチューニング前提でかつ、正常に動く保証はない点に注意を。

#命令
あなたはVBAのコーダーです。候補者に参加可能なグループインタビューを割り振った組み合わせの作成を行うマクロを作成してください。
入力データをもとに後述の要件に沿った処理を行った結果を「出力」シートに出力するコーディングを行ってください。

#入力データ：候補者
候補者がレコードのテーブルデータです。キーは「no」列です。日付の列が「○」になっている候補者は参加可能です。優先順位は小さいほうがグループインタビューの割り振りを優先します。割り振りを作業用Excelファイルの「候補者」シートにあります。例としては以下のようになります。
--
no,優先順位,性／年代,5月20日,5月21日,5月22日,5月23日,5月24日,5月25日,5月26日,5月27日,5月28日,5月29日,上記のいずれも参加できない
1,1,女性／40代,,,○,○,○,,○,○,○,,
2,1,女性／30代,○,,,,,○,○,○,○,,
3,1,女性／30代,,,,,,○,○,○,,,
4,2,女性／30代,,,,,○,○,○,○,,,
5,2,女性／70代,○,○,,,,○,○,,,,
6,3,男性／40代,,,,,○,,,,○,○,
7,3,男性／50代,○,○,○,,,○,○,○,,,
8,1,女性／30代,,,,○,,,,,,,
9,3,女性／40代,○,○,○,○,○,○,○,○,○,○,
10,1,男性／60代,○,○,○,○,○,○,○,○,○,○,
--

#入力データ：グループインタビュー
グループインタビューがレコードのテーブルデータです。キーは「id」列です。開催日程、開催時刻はグループインタビューが開始される日時です。枠数は必要人数です。作業用Excelファイルの「グループインタビュー」シートにあります。例としては以下のようになります。
--
id,開催日程,開催時刻,枠数
101,2023/5/20,10:00,4
102,2023/5/20,13:00,4
103,2023/5/20,16:00,4
104,2023/5/21,10:00,4
105,2023/5/21,13:00,4
106,2023/5/21,16:00,4
107,2023/5/22,10:00,4
108,2023/5/22,13:00,4
109,2023/5/22,16:00,4
110,2023/5/23,10:00,4

--

#要件
要件1. 候補者シート、グループインタビューシートは編集禁止です。配列や辞書でを用いてデータの処理を行ってください。
要件2. 下記の基準で候補者に参加するグループインタビューの割り振りを行います。
2A. グループインタビューの回ごとに参加可能な候補者のリスト作成してください。
2B. 2Aの参加可能な人数から枠人数を引いた差を「余剰人数」それぞれ算出。
2C. 余剰人数にランダム値を掛けた値をグループインタビューの「優先度」とします。
2D. まず、グループインタビューの「優先度」の値が小さいほど優先。次に、候補者ごとの優先順位の値が小さい候補者ほど優先。その回が参加可能でない候補者、あるいは優先順位が空欄の候補者は割り当て対象外です。
2E. 1度割り当てた候補者は別のグループインタビューで割り当てることはできません。
2D. 空いている枠数が無い、あるいは参加可能な候補者がいない状態になるまで割り当てを行ってください。 
要件3. １つのパターンが完成したら、そのパターンにおける空いている枠数を算出して下さい。また、割り当て済の候補者の優先順位の平均値を算出してください。
要件4. 10パターン作成し、まず、枠数の余りが最小、次に優先順位の平均が最小となるベストパターンを算出してください。
要件5. ベストパターンの候補者の割り振り結果を「出力」シートに出力してください。

自分ですべてコーディングする時との違い

自分でやる分には気にする必要が無かったが、ChatGPTを活用するうえで避けられないポイントがいくつかある。

• 入力データと出力例とやりたいことを投入すれば、何がしかは作成してくれる。
• web版ChatGPTの仕様上、出力はランダム化されているので、同じプロンプトで必ずしも同じ出力になるわけではない。
• ChatGPTが作成したものが、そのまま使えるとは限らない。何がしかのチューニングは必要。コーディングの知識が全くない人間がChatGPTにツールを作成させ、それを完全に信用してチェックもせず使うのは危険。
• 会社や部署内の管理規約がある場合は、ChatGPTのプロンプトで明示することで対応してくれる。
• メンテナンス性の高さを気にするなら、クラス等のオブジェクトの設計をプロンプトで明記することが望ましい。 これは後で気づいたのだが、上で例示したプロンプトは、クラスに関する記述がないため、オブジェクト指向のメンテナンス性の高いコードがなかなか出力されなかった。何回かプロンプトを投入を繰り返しているうちに、たまたまクラスが使われたメンテナンス性の高そうなコードがでてきたので、今回はそれを基に作成した。（後述の「おまけ」に記載）

成果

テストデータ用にチューニングしたコードから、さらに任意の条件を追加や、参加可能な候補者のデータを作成等の案件用のチューニングも施した。この作成したマクロを使うことで、組み合わせの作成が自動化し、枠数に届かない回がどうしても出る場合のみ調整、修正を対応すればよくなった。それにより、シフト作成作業時間が1時間から5分へと短縮させることが出来た。 また、マクロを作成するためのコーディングの時間自体も、すべてを人力でやるより、3分の2程度に削減できた。

おわりに

まだ試行錯誤中だが、ChatGPTと協力することにより作業負担を減らすことが可能となることを実感できた。私自身、最近はコーディングを負担に感じていたので、この経験はChatGPTと共働する新しい方法を学ぶための貴重な機会だった。もはや要件定義が適切に設計さえできれば、多少はコーディングできるよ、という人でも独自ツールの作成は困難ではないようだ。 特にツール作成における教育コスト、展開コストの削減に与えるインパクトは大きいはずだ。統制上の心配もあるだろうが、読みやすい均一的なコードにはなるので、検証素材をしっかり用意する等の対策を取ればよい。そういった点も踏まえChatGPTの活用を前提とした教育プログラムを実施して、普及策をとったほうがメリットは大きいと思う。

展望としては、ChatGPTをはじめとしたAIツールをコーディングに利用することで、私たちの仕事の仕方を改革し、業務改善に活用することは可能で、この先の世界は今まで以上にそれを取り組むことが求められるのだろう。汎用性も高く、人間なら悲鳴を上げるリクエストに対して文句を言わずにこなすことができツールとして優秀だが、人間側のタスクとして、問題点の洗い出し、具体的な解決方法の立案や要件定義といったことは残る。

話が逸れるが、冒頭で触れたドラえもんを思い返すと、ドラえもん自体は大まかには「ジャイアンに仕返ししたい」「スネオを見返したい」といった、のび太の意思と事情を聞いたうえで、それに相応しい未来道具をマッチングする、単に未来道具のレコメンドエンジンが主機能のロボットだ。

結局のところ、人間の領分として、どうありたいか、問題にどう取り組むか意思を持ち、ツールでも何でも活用して目標の達成を目指すことが大切なのは変わりはない。

今後はよりChatGPTとの交流を深め、積極的に活用していきたい。今回のようにChatGPTを活用して解決できた事例があればまた紹介したいと思う。この記事があなたのChatGPT活用の参考になれば嬉しい。

以上。

おまけ

参考までに、実際にChatGPTが提示したコードをチューニングした後のものを掲載する。ただしこれは私のほうで用意したテストデータのみを対象としており、別のデータで使用するにはチューニングが必要な点に注意。

●Main.bas

Attribute VB_Name = "Main"
Sub AllocateGroupInterviews()
    Dim targetSheet As Worksheet
    Dim interviewSheet As Worksheet
    Dim outputSheet As Worksheet
    Dim targetData As Variant
    Dim interviewData As Variant
    Dim outputData As Variant
    Dim groupInterviews As collection
    Dim availableParticipants As collection
    Dim bestPattern As collection
    Dim bestPatternRemainder As Integer
    Dim bestPatternAvgPriority As Double
    Dim i As Long, j As Long
    Const iteration As Long = 10

    ' シートの設定
    Set targetSheet = ThisWorkbook.Sheets("候補者")
    Set interviewSheet = ThisWorkbook.Sheets("グループインタビュー")
    Set outputSheet = ThisWorkbook.Sheets("出力")

    ' データの取得
    targetData = targetSheet.UsedRange.Value
    interviewData = interviewSheet.UsedRange.Value

    ' 出力シートの準備
    outputSheet.Cells.ClearContents
    outputData = targetData
    outputSheet.Range(outputSheet.Cells(1, 1), outputSheet.Cells(UBound(outputData, 1), UBound(outputData, 2))).Value = outputData

    ' ベストパターンの初期化
    Set bestPattern = Nothing
    bestPatternRemainder = 9999
    bestPatternAvgPriority = 9999

    ' 10パターンの割り当てを作成
    For i = 1 To iteration
        ' グループインタビューのリスト作成
        Set groupInterviews = CreateGroupInterviews(interviewData)

        ' 候補者の参加可能なグループインタビューのリスト作成
        Set availableParticipants = CreateAvailableParticipants(targetData, groupInterviews)

        ' パターンごとの割り当てを行う
        AllocatePattern targetData, groupInterviews, availableParticipants

        ' 空いている枠数と優先順位の平均値を算出
        Dim remainder As Integer
        remainder = CountRemainder(groupInterviews)
        Dim avgPriority As Double
        avgPriority = CalculateAveragePriority(groupInterviews)

        ' ベストパターンの更新
        If bestPattern Is Nothing Or remainder < bestPatternRemainder Or (remainder = bestPatternRemainder And avgPriority < bestPatternAvgPriority) Then
            Set bestPattern = CopyCollection(groupInterviews)
            bestPatternRemainder = remainder
            bestPatternAvgPriority = avgPriority
        End If
    Next i

    ' ベストパターンを出力シートに反映
    Dim row As Long
    Dim id As String
    Dim assignedParticipaants As collection
    Dim no As String
    Dim prtc As Variant

    With outputSheet
        .Cells(1, UBound(outputData, 2) + 1) = "ベストパターン"
        For row = 2 To UBound(outputData)
            For Each interview In bestPattern
                id = interview.id
                For Each prtc In interview.assignedParticipants
                    no = prtc.no
                    If .Cells(row, 1).Value = no Then
                        .Cells(row, UBound(outputData, 2) + 1) = id
                    End If
                Next prtc
            Next interview
        Next row
    End With
    MsgBox "完了しました。"
End Sub

Function CreateGroupInterviews(interviewData As Variant) As collection
    Dim groupInterviews As New collection
    Dim i As Long
    Dim interview As GroupInterview

    For i = 2 To UBound(interviewData, 1)
        Set interview = New GroupInterview
        interview.id = interviewData(i, 1)
        interview.day = interviewData(i, 2)
        interview.time = interviewData(i, 3)
        interview.capacity = interviewData(i, 4)

        groupInterviews.Add interview
    Next i

    Set CreateGroupInterviews = groupInterviews
End Function

Function CreateAvailableParticipants(targetData As Variant, groupInterviews As collection) As collection
    Dim availableParticipants As New collection
    Dim i As Long, j As Long
    Dim prtc As Participant
    Dim Availability As Availability
    Dim interview As Variant

    For i = 2 To UBound(targetData, 1)
        Set prtc = New Participant
        prtc.no = targetData(i, 1)
        prtc.priority = targetData(i, 2)
        prtc.name = targetData(i, 3)

        '優先順位ありのみ
        If prtc.priority > 0 Then
            For j = 4 To UBound(targetData, 2) - 1
                If targetData(i, j) = "○" Then
                    For Each interview In groupInterviews
                        '日時の判定、今回は時間は見ない
                        If interview.day = CDate(targetData(1, j)) Then
                            Set Availability = New Availability
                            Availability.interviewID = interview.id
                            Availability.day = interview.day
                            Availability.time = interview.time
                            prtc.Availability.Add Availability
                        End If
                    Next interview
                End If
            Next j
        End If
        availableParticipants.Add prtc
    Next i

    Set CreateAvailableParticipants = availableParticipants
End Function

Sub AllocatePattern(ByRef targetData As Variant, groupInterviews As collection, availableParticipants As collection)

    Dim assignedParticipants As Object
    Set assignedParticipants = CreateObject("Scripting.Dictionary")
    Dim Participant As Participant
    Dim i As Long, j As Long
    Dim interview As GroupInterview

    Randomize

    ' グループインタビューごとに割り当てを行う
    For i = 1 To groupInterviews.count

        Set interview = groupInterviews(i)

        For Each Participant In availableParticipants
            ' 参加可能な候補者を抽出
            If IsParticipantAvailableForInterview(Participant, interview) Then
                interview.availableParticipants.Add Participant
            End If
        Next Participant

        ' 余剰人数を計算
        Dim surplus As Integer
        surplus = interview.availableParticipants.count - interview.capacity

        ' 余剰人数にランダム値を掛けて優先度を計算
        interview.priority = surplus * rnd
    Next i

    ' 優先度でソート
    SortInterviewsByPriority groupInterviews

    For i = 1 To groupInterviews.count
        Dim availableParticipantsForInterview As collection
        Set availableParticipantsForInterview = groupInterviews(i).availableParticipants
        ' 参加可能な候補者がいる場合
        If availableParticipantsForInterview.count > 0 Then

            ' 優先順位でソート
            SortParticipantsByPriority availableParticipantsForInterview

            ' 候補者を割り当て
            For j = 1 To availableParticipantsForInterview.count

                Set Participant = availableParticipantsForInterview(j)

                If Not assignedParticipants.exists(Participant.no) And groupInterviews(i).capacity > groupInterviews(i).assignedParticipants.count Then

                     ' 割り当て済に追加
                    assignedParticipants.Add Participant.no, Participant
                    groupInterviews(i).assignedParticipants.Add Participant
                End If
            Next j
        End If
    Next i
End Sub

Function IsParticipantAvailableForInterview(prtc As Participant, interview As GroupInterview) As Boolean
    Dim i As Long
    Dim Availability As Availability

    For i = 1 To prtc.Availability.count

        Set Availability = prtc.Availability(i)

        If Availability.interviewID = interview.id And Availability.day = interview.day Then
            IsParticipantAvailableForInterview = True
            Exit Function
        End If
    Next i

    IsParticipantAvailableForInterview = False
End Function

Sub SortParticipantsByPriority(participants As collection)
    Dim i As Long, j As Long

    For i = 1 To participants.count - 1
        For j = i + 1 To participants.count
            If participants(i).priority > participants(j).priority Then
                participants.Add participants(j), Before:=i
                participants.Remove j + 1
            End If
        Next j
    Next i
End Sub
Sub SortInterviewsByPriority(groupInterviews As collection)
    Dim i As Long, j As Long

    For i = 1 To groupInterviews.count - 1
        For j = i + 1 To groupInterviews.count
            If groupInterviews(i).priority > groupInterviews(j).priority Then
                groupInterviews.Add groupInterviews(j), Before:=i
                groupInterviews.Remove j + 1
            End If
        Next j
    Next i
End Sub

Function CountRemainder(groupInterviews As collection) As Integer
    Dim count As Integer
    Dim interview As GroupInterview
    count = 0

    Dim i As Long

    For i = 1 To groupInterviews.count
        Set interview = groupInterviews(i)
        count = count + interview.capacity - interview.assignedParticipants.count
    Next i

    CountAvailableSlots = count
End Function

Function CalculateAveragePriority(groupInterviews As collection) As Double
    Dim sum As Double
    Dim count As Long
    Dim prtc As Participant
    sum = 0
    count = 0

    Dim i, j As Long

    For i = 1 To groupInterviews.count
        For j = 1 To groupInterviews(i).assignedParticipants.count
            Set prtc = groupInterviews(i).assignedParticipants(j)
            sum = sum + prtc.priority
            count = count + 1
        Next j
    Next i

    If count > 0 Then
        CalculateAveragePriority = sum / count
    Else
        CalculateAveragePriority = 0
    End If
End Function

Function CopyCollection(collection As collection) As collection
    Dim newCollection As New collection
    Dim i As Long

    For i = 1 To collection.count
        newCollection.Add collection(i)
    Next i

    Set CopyCollection = newCollection
End Function

●Availability.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Availability"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public interviewID As Long
Public day As Date
Public time As String

●GroupInterview.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "GroupInterview"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public id As Long
Public day As Date
Public time As String
Public capacity As Integer
Public assignedParticipants As collection
Public priority As Double
Public availableParticipants As collection

' コンストラクタ
Private Sub Class_Initialize()
    Set counter = CreateObject("Scripting.Dictionary")
    Set assignedParticipants = New collection
    Set availableParticipants = New collection
End Sub

●Participant.cls

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "Participant"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Public no As Long
Public name As String
Public Availability As collection
Public priority As Double

' コンストラクタ
Public Sub Class_Initialize()
    Set Availability = New collection
End Sub