Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(指定なし : 指定なし)
各組合計値の平均でグループ分け
投稿日時: 24/08/23 09:31:05
投稿者: tako552101

お世話になります。Win10 ver2010です。
 
100名程度が参加するイベントで4列、もしくは3列のグループに分ける際、各組の各々が持っているポイントの合計が平均になるように組み分けしたいのですがいい方法がありません。
 
■3人組の場合(成功例/一致7件から目視で調整)
組    Aグループ    Bグループ    Cグループ
    ID    POINT    ID    POINT    ID    POINT    平均    合計値
1    1049    4    1027    9    1069    22    11.6    35
2    1079    5    1093    8    1018    21    11.3    34
3    1080    7    1005    12    1007    15    11.3    34
4    1030    7    1082    10    1053    17    11.3    34
5    1022    8    1028    13    1061    13    11.3    34
6    1009    6    1050    8    1089    21    11.6    35
7    1065    5    1029    11    1042    18    11.3    34
8    1071    1    1010    13    1056    20    11.3    34

34
 
現在は3人組ならポイントの低い順に並べ替えて、縦に3グループに分けたものをA、B、C各グループに分け、各列共にランダム値で並べ替え、参加全員の合計値の平均を2通り算出して、各組の合計値と全体の平均値を比較し、同じならカウント〜マクロでループし、その一致数の高いパターンを選択して後は目視でコツコツ合わせる…
といった具合ですが、一致するのは34組中せいぜい12-13で、その後の目視での作業が大変です。
 
ソルバーを使うやり方も試しましたがこちらは、その差異が9ポイント以上その精度を高めることができず、やはり目視での作業が大変です。
 
何か良いアイディアがありましたら、ご指導いただきたくお願いします。

回答
投稿日時: 24/08/23 10:19:21
投稿者: Suzu

いきなりデータを、列ごとに移動しないとダメですか?
 
私なら、作業列を使います。
 
POIT順に並び替え
E1 : =SUM(B2:B25)
F1 : =F1/3 ---- 組分けの目標値
 
F2:=SUMIF(C$2:C$25,"="&$F2,B$2:B$25) 下オートフィル
G2:=COUNTIF(C$2:C$25,"="&$F2) 下オートフィル
 

	A	B	C	D	E	F	G
1	ID	POINT	組		274	91.33333333	
2	1069	22			A	0	0
3	1018	21			B	0	0
4	1089	21			C	0	0
5	1056	20					
6	1042	18					
7	1053	17					
8	1007	15					
9	1010	13					
10	1028	13					
11	1061	13					
12	1005	12					
13	1029	11					
14	1082	10					
15	1027	9					
16	1022	8					
17	1050	8					
18	1093	8					
19	1030	7					
20	1080	7					
21	1009	6					
22	1065	5					
23	1079	5					
24	1049	4					
25	1071	1					

 
ここまでやったら、
C2〜C7 にABCABC を入れ、オートフィル
 
	A	B	C	D	E	F	G
1	ID	POINT	組		274	91.33333333	
2	1069	22	A		A	100	8
3	1018	21	B		B	91	8
4	1089	21	C		C	83	8
5	1056	20	A				
6	1042	18	B				
7	1053	17	C				
8	1007	15	A				
9	1010	13	B				
10	1028	13	C				
11	1061	13	A				
12	1005	12	B				
13	1029	11	C				
14	1082	10	A				
15	1027	9	B				
16	1022	8	C				
17	1050	8	A				
18	1093	8	B				
19	1030	7	C				
20	1080	7	A				
21	1009	6	B				
22	1065	5	C				
23	1079	5	A				
24	1049	4	B				
25	1071	1	C				

 
平均値、91.333・・に対し G2〜G4の A〜C の合計値、から、Aが高く、Cが低いのが読み取れますから、
C2を A→C、C4をC→A
 まだ、Aが高いので C5を A→C、C7をC→A
  :
 
と調整し
 
最終的に
	A	B	C	D	E	F	G
1	ID	POINT	組		274	91.33333333	
2	1069	22	C		A	92	8
3	1018	21	B		B	91	8
4	1089	21	A		C	91	8
5	1056	20	C				
6	1042	18	B				
7	1053	17	A				
8	1007	15	C				
9	1010	13	B				
10	1028	13	A				
11	1061	13	C				
12	1005	12	B				
13	1029	11	A				
14	1082	10	A				
15	1027	9	B				
16	1022	8	C				
17	1050	8	A				
18	1093	8	B				
19	1030	7	C				
20	1080	7	A				
21	1009	6	B				
22	1065	5	C				
23	1079	5	A				
24	1049	4	B				
25	1071	1	C				

 
の様に修正。
 
あとは、オートフィルタで、A、B、C の各組のデータを抽出し列ごとに並べます。

回答
投稿日時: 24/08/23 10:27:51
投稿者: Suzu

引用:
POIT順に並び替え
E1 : =SUM(B2:B25)
F1 : =F1/3 ---- 組分けの目標値
  
F2:=SUMIF(C$2:C$25,"="&$F2,B$2:B$25) 下オートフィル
G2:=COUNTIF(C$2:C$25,"="&$F2) 下オートフィル

アドレス間違えました。
 
正しくは
E1 : =SUM(B2:B25)
F1 : =E1/3 ---- 組分けの目標値
  
F2:=SUMIF(C$2:C$25,"="&$E2,B$2:B$25) 下オートフィル
G2:=COUNTIF(C$2:C$25,"="&$E2) 下オートフィル
です。
 
 
4組に分けるなら、同様にし、
 C2〜C5、C6〜C9、・・と DCBA と 順に入れ替えて行けば良いかと。
 
	A	B	C	D	E	F	G	H
1	ID	POINT	組			274	68.5	
2	1069	22	D			A	67	6
3	1018	21	C			B	69	6
4	1089	21	B			C	70	6
5	1056	20	A			D	68	6
6	1042	18	D					
7	1053	17	C					
8	1007	15	B					
9	1010	13	A					
10	1028	13	D					
11	1061	13	C					
12	1005	12	B					
13	1029	11	A					
14	1082	10	A					
15	1027	9	B					
16	1022	8	C					
17	1050	8	D					
18	1093	8	A					
19	1030	7	B					
20	1080	7	C					
21	1009	6	D					
22	1065	5	A					
23	1079	5	B					
24	1049	4	C					
25	1071	1	D					

投稿日時: 24/08/23 11:06:12
投稿者: tako552101

すみません、説明が下手でしたでしょうか。
 
平均をとりたいのは3列の縦(A、B、C)の合計平均ではなく、各行横方向の合計値の平均です。

■3人組の場合							
組	Aグループ	Bグループ	Cグループ		
	ID	POINT	ID	POINT	ID	POINT	合計値
1	1049	4	1027	9	1069	22	35 ← 合計値が各行共平均値
2	1079	5	1093	8	1018	21	34 ← となるようにしたい
3	1080	7	1005	12	1007	15	34 ←
4	1030	7	1082	10	1053	17	34 ←
5	1022	8	1028	13	1061	13	34 ←
6	1009	6	1050	8	1089	21	35 ←
7	1065	5	1029	11	1042	18	34 ←
8	1071	-1	1010	13	1056	22	34 ←

※上記は各行とも34、35でその差異1で平均が取れています。
 
よろしくお願いします。

回答
投稿日時: 24/08/23 12:44:43
投稿者: Suzu

縦でも横でも一緒では?
 
F1 : =E1/8
 
F2 : =SUMIF(C$2:C$25,"="&E2,B$2:B$25)
G2 : =F$1-F2
H2 : =COUNTIF(C$2:C$25,$E2)
 
 グループ数が多いので、グループを 1〜8 にしました。
 目安の数値があった方が作業し易いのでG列を増やしました。 (不足点数)
 
POINT順に並べ、C2〜C9 を 逆順に したところまで
が 下記
 

	A	B	C	D	E	F	G	H
1	ID	POINT	組		274	34.25		
2	1069	22	8		1	21	13.25	2
3	1056	22	7		2	22	12.25	2
4	1018	21	6		3	24	10.25	2
5	1089	21	5		4	24	10.25	2
6	1042	18	4		5	26	8.25	2
7	1053	17	3		6	26	8.25	2
8	1007	15	2		7	26	8.25	2
9	1028	13	1		8	21	13.25	2
10	1010	13						
11	1061	13						
12	1005	12						
13	1029	11						
14	1082	10						
15	1027	9						
16	1022	8						
17	1093	8						
18	1050	8	1					
19	1080	7	2					
20	1030	7	3					
21	1009	6	4					
22	1079	5	5					
23	1065	5	6					
24	1049	4	7					
25	1071	-1	8					

  (ここまでだったら、VBAを使用しても良いのでは?)
 
あとは、G列の不足POINTを目安に、手動でC10〜C17 に 1〜8 を割り振る。
 
 
引用:
※上記は各行とも34、35でその差異1で平均が取れています。

今回は、差異「1」でしたが、そうで無い場合もありますよね?
 
様は、その「1」という しきい値 は変動しうるので 手動の方が調整しやすい のではありませんか?
その手動調整について、どれだけ手間を省けるか。
 
入力だけ の方が 絶対に楽です。
セルの入れ替えなんかをやろうとするから、手間がかかるのです。
 
そんな整形は後で良いのです。
どんな組み合わせにするか を 手動でどれだけ楽にできるか を考えましょう。

回答
投稿日時: 24/08/23 14:55:48
投稿者: sk

引用:
100名程度が参加するイベントで4列、もしくは3列のグループに分ける際、
各組の各々が持っているポイントの合計が平均になるように組み分けしたい

「全ての参加者の人数」を「基本グループの数( 1 組当たりの基本人数)」で
除した際に 1 以上の剰余人数が発生した場合はどのように扱うのでしょうか。
 
例えば、全ての参加者の人数が 100、基本グループの数が 3 である場合の
除算の商は 100 \ 3 = 33、剰余は 100 Mod 3 = 1 となりますが、
「余った 1 名のみで 34 つめの組を作る」のと「 33 組のうちのいずれかの組に
追加枠を 1 名分ずつ振り分ける( 4 名枠の組が 1 つ、3 名枠の組が 32 つとなり、
1 名のみの D グループが生じる)」とでは大きく意味が異なります。
 
引用:
現在は3人組ならポイントの低い順に並べ替えて、縦に3グループに分けたものを
A、B、C各グループに分け、各列共にランダム値で並べ替え、参加全員の合計値の
平均を2通り算出して、各組の合計値と全体の平均値を比較

また、そのイベントにおいて各参加者を「組」や「グループ」に
振り分ける目的を明記されることをお奨めします。

投稿日時: 24/08/23 15:46:47
投稿者: tako552101

Suzuさん、ありがとうございます。
 
96名ですと32組となり、1〜32までの数値を平均値を見ながら入力していくのは、私には難しいです。
 
 
skさん、ありがとうございます。
 
端数は事前に処理するので、3人組なら3で割れる数字と考えていただいていいです。100なら99で33組。
 

引用:
目的を明記されることをお奨めします

組み分けた例えば32(96名)グループは、グループ毎の持ちポイントをできるだけ平均化して、次のイベントで公平にグループ合計ポイントで競えるようにするためです。

回答
投稿日時: 24/08/23 17:39:20
投稿者: sk

引用:
端数は事前に処理するので、3人組なら3で割れる数字と考えていただいていいです。

ではとりあえずの叩き台として、次のようなワークシートを元に
組分け処理を行なう場合。
 
-------------------------------------------------------------------
	A	B
1	ID	POINT
2	1005	12
3	1007	15
4	1009	6
5	1010	13
6	1018	21
7	1022	8
8	1027	9
9	1028	13
10	1029	11
11	1030	7
12	1042	18
13	1049	4
14	1050	8
15	1053	17
16	1056	20
17	1061	13
18	1065	5
19	1069	22
20	1071	1
21	1079	5
22	1080	7
23	1082	10
24	1089	21
25	1093	8
-------------------------------------------------------------------
 
( 標準モジュール)
-------------------------------------------------------------------
Sub GroupingByPoint()
 
    '参照範囲の取得
 
    Dim wsSource As Excel.Worksheet
    Dim rngSource As Excel.Range
    Dim lngFirstRow As Long
    Dim lngLastRow As Long
     
    'このブックの 1 つめのワークシートを参照元とする
    Set wsSource = ThisWorkbook.Worksheets(1)
     
    With wsSource
         
        lngFirstRow = 2
        lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
         
        If lngLastRow < lngFirstRow Then
            Set wsSource = Nothing
            Exit Sub
        End If
         
        Set rngSource = .Range(.Cells(lngFirstRow, 1), _
                               .Cells(lngLastRow, 2))
 
    End With
 
    'メンバー情報の定義と初期化
 
    Dim rsMembers As ADODB.Recordset
      
    Set rsMembers = New ADODB.Recordset
     
    With rsMembers
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Fields.Append "ID", adInteger
        .Fields.Append "POINT", adInteger
        .Fields.Append "組", adInteger
        .Open
    End With
 
    Dim rngTargetRow As Excel.Range
    Dim varMembersCount As Variant
    Dim varTotalPoints As Variant
     
    varMembersCount = CDec(0)
    varTotalPoints = CDec(0)
     
    For Each rngTargetRow In rngSource.Rows
        '[ID]が記録されている行のみメンバ―情報に追加する
        If rngTargetRow.Columns(1).Value <> "" Then
            rsMembers.AddNew
            rsMembers![組].Value = 0
            rsMembers![ID].Value = rngTargetRow.Columns(1).Value
            rsMembers![Point].Value = rngTargetRow.Columns(2).Value
            rsMembers.Update
            'メンバー人数のカウント
            varMembersCount = varMembersCount + 1
            'ポイント合計の加算
            varTotalPoints = varTotalPoints + CLng(rngTargetRow.Columns(2).Value)
        End If
    Next
     
    '組分け対象となるメンバーが存在しない場合は終了
    If varMembersCount = 0 Then
        rsMembers.Close
        Set rsMembers = Nothing
        Set rngSource = Nothing
        Set wsSource = Nothing
        Exit Sub
    End If
     
    Dim varAveragePoints As Variant
     
    '全メンバーのポイントの平均を取得
    varAveragePoints = CDec(varTotalPoints / varMembersCount)
     
    '組情報の定義と初期化
     
    Dim rsTeams As ADODB.Recordset
      
    Set rsTeams = New ADODB.Recordset
     
    With rsTeams
        .CursorLocation = adUseClient
        .CursorType = adOpenDynamic
        .LockType = adLockOptimistic
        .Fields.Append "組", adInteger
        .Fields.Append "人数", adInteger
        .Fields.Append "人数上限", adInteger
        .Fields.Append "POINT合計", adInteger
        .Fields.Append "POINT平均", adDouble
        .Open
    End With
     
    Const BasicMembersCountInTeam As Long = 3
     
    Dim lngTeamsCount As Long
    Dim lngSurplusCount As Long
    Dim lngGroupsCount As Long
     
    lngTeamsCount = varMembersCount \ BasicMembersCountInTeam
    lngSurplusCount = varMembersCount Mod BasicMembersCountInTeam
    lngGroupsCount = BasicMembersCountInTeam - (lngSurplusCount <> 0)
     
    Dim lngTeam As Long
     
    For lngTeam = lngTeamsCount To 1 Step -1
        rsTeams.AddNew
        rsTeams![組].Value = lngTeam
        rsTeams![人数].Value = 0
        If lngSurplusCount > 0 Then
            rsTeams![人数上限].Value = BasicMembersCountInTeam + 1
            lngSurplusCount = lngSurplusCount - 1
        Else
            rsTeams![人数上限].Value = BasicMembersCountInTeam
        End If
        rsTeams.Update
    Next
     
    '組分け処理
         
    Dim rsSubMembers As ADODB.Recordset
     
    Set rsSubMembers = rsMembers.Clone
     
    Dim lngTeamMembersCount As Long
    Dim varTotalPointsInTeam As Variant
    Dim varAveragePointsInTeam As Variant
    Dim varTheoreticalPoints As Variant
     
    '組情報を人数上限の昇順、組番号の昇順に並べ替える
    rsTeams.Sort = "[人数上限] ASC, [組] ASC"
     
    '全ての組情報を参照し終えるまでループ
    Do Until rsTeams.EOF
        '組のポイント合計の初期化
        varTotalPointsInTeam = 0
        Do
            '最初のメンバー選択時
            If rsTeams![人数].Value = 0 Then
                'まだ組が決まっていないメンバーを抽出し、
                'ポイントの降順、IDの昇順に並べ替えた結果を得る
                rsMembers.Filter = "[組] = 0"
                rsMembers.Sort = "[POINT] DESC, [ID] ASC"
            '残り 1 枠になった場合
            ElseIf rsTeams![人数].Value = (rsTeams![人数上限].Value - 1) Then
                '「全メンバーのポイント平均にこの組の人数上限を乗じた結果」から
                '「現時点での組のポイント合計」を減じた結果を求め、
                '適正ポイントの理論値とする
                varTheoreticalPoints = (varAveragePoints * rsTeams![人数上限].Value) - varTotalPointsInTeam
                 
                'まだ組が決まっておらず、かつポイントが理論値以下であるメンバーを抽出し、
                'ポイントの降順、IDの昇順に並べ替えた結果を得る。
                'この時点で先頭となったメンバーが既定の候補者となる。
                rsMembers.Filter = "([組] = 0) AND ([POINT]<=" & varTheoreticalPoints & ")"
                rsMembers.Sort = "[POINT] DESC, [ID] ASC"
                 
                'まだ組が決まっておらず、かつポイントが理論値より大きいメンバーを抽出し、
                'ポイントの昇順、IDの昇順に並べ替えた結果を得る
                rsSubMembers.Filter = "([組] = 0) AND ([POINT]>" & varTheoreticalPoints & ")"
                rsSubMembers.Sort = "[POINT] ASC, [ID] ASC"
                 
                'どちらの結果にも候補者がいる場合
                If (rsMembers.EOF = False) And (rsSubMembers.EOF = False) Then
                    '候補者のポイントと適正ポイントの理論値との差がより小さい方の結果を採用する
                    If Abs(rsMembers![Point].Value - varTheoreticalPoints) > Abs(rsSubMembers![Point].Value - varTheoreticalPoints) Then
                        rsMembers.Filter = "[ID]=" & rsSubMembers![ID].Value
                        rsMembers.Sort = ""
                    End If
                '前者の結果に候補者がおらず、かつ後者の結果に候補者がいる場合
                ElseIf (rsMembers.EOF = True) And (rsSubMembers.EOF = False) Then
                    '後者の結果から候補者を選ぶ
                    rsMembers.Filter = "[ID]=" & rsSubMembers![ID].Value
                    rsMembers.Sort = ""
                'どちらの結果にも候補者がいない場合
                ElseIf (rsMembers.EOF = False) And (rsSubMembers.EOF = False) Then
                    'まだ組が決まっていないメンバーを抽出し、
                    'ポイントの昇順、IDの昇順に並べ替えた結果を得る
                    rsMembers.Filter = "[組] = 0"
                    rsMembers.Sort = "[POINT] ASC, [ID] ASC"
                End If
            '2 人目以降かつ残り 2 枠以上空いている場合
            Else
                'まだ組が決まっていないメンバーを抽出し、
                'ポイントの昇順、IDの昇順に並べ替えた結果を得る
                rsMembers.Filter = "[組] = 0"
                rsMembers.Sort = "[POINT] ASC, [ID] ASC"
            End If
            '抽出結果の先頭のメンバーの組の割り当て
            rsMembers![組].Value = rsTeams![組].Value
            '現時点での組のポイント合計を加算
            varTotalPointsInTeam = varTotalPointsInTeam + rsMembers![Point].Value
            rsMembers.Update
            '組の人数を 1 追加
            rsTeams![人数].Value = rsTeams![人数].Value + 1
            rsTeams.Update
        '組の人数が上限に達するまで繰り返す
        Loop Until rsTeams![人数].Value = rsTeams![人数上限].Value
         
        'ポイントの合計と平均を保存
        rsTeams![POINT合計].Value = varTotalPointsInTeam
        rsTeams![POINT平均].Value = varTotalPointsInTeam / rsTeams![人数].Value
        rsTeams.Update
         
        '次の組へ移動
        rsTeams.MoveNext
    Loop
     
    '組分け結果の出力
     
    rsTeams.Filter = ""
    rsTeams.Sort = "[組] ASC"
     
    rsMembers.Filter = ""
    rsMembers.Sort = "[組] ASC, [POINT] ASC, [ID] ASC"
     
    Dim wsDestination As Excel.Worksheet
    Dim lngTargetColumn As Long
    Dim lngColumn As Long
     
    '新規ブックの 1 つめのワークシートを出力先とする
    Set wsDestination = Workbooks.Add.Worksheets(1)
     
    With wsDestination
         
        lngTargetColumn = 1
         
        For lngColumn = 0 To rsTeams.Fields.Count - 1
            .Cells(1, lngTargetColumn + lngColumn).Value = rsTeams.Fields(lngColumn).Name
        Next
        .Cells(2, lngTargetColumn).CopyFromRecordset rsTeams
        lngTargetColumn = lngTargetColumn + rsTeams.Fields.Count + 1
         
        For lngColumn = 0 To rsMembers.Fields.Count - 1
            .Cells(1, lngTargetColumn + lngColumn).Value = rsMembers.Fields(lngColumn).Name
        Next
        .Cells(2, lngTargetColumn).CopyFromRecordset rsMembers
         
        .UsedRange.EntireColumn.AutoFit
        .Select
        .Cells(1, 1).Select
     
    End With
     
    rsSubMembers.Close
    Set rsSubMembers = Nothing
    rsMembers.Close
    Set rsMembers = Nothing
    rsTeams.Close
    Set rsTeams = Nothing
     
    Set rngSource = Nothing
    Set wsSource = Nothing
     
    Set wsDestination = Nothing
     
End Sub
-------------------------------------------------------------------
 
A、B、C のグループ分けに関しては詳細な仕様(どのような基準で
グループを決めているのか、既に決定済みのグループを変更することが
あるのか/変更してよいのか等)が不明であるため考慮していません。
 
引用:
グループ毎の持ちポイントをできるだけ平均化して、次のイベントで
公平にグループ合計ポイントで競えるようにするためです。

「グループごとのポイントの合計/平均をなるべく均一化すること」
「組ごとのポイントの合計/平均をなるべく均一化すること」は
あくまで別の問題でしょう。

投稿日時: 24/08/24 06:04:46
投稿者: tako552101

skさん、ありがとうございます。
 
わざわざコード作製していただき、深く感謝申し上げます。完璧な結果でとても満足しています。
 
コードを見ても私には何を行っているのかほぼ理解できませんが、少しづつひも解いていきたいと思います。
 
もう1つだけお願いがあるのですが、現在は3人組(ABC)ですが、4人組(ABCD)の場合は、コード中どこを修正すればいいのでしょうか。
 
よろしくお願いします。

回答
投稿日時: 24/08/28 12:01:47
投稿者: sk

引用:
コードを見ても私には何を行っているのかほぼ理解できません。

基本的にやってること自体は非常に大雑把で、
 
1. その時点で最もポイントが高い参加者を 1 名選ぶ。
 
2. その時点で最もポイントが低い参加者を 1 名選ぶ。
 
3. 上記 1, 2 で選ばれた参加者 2 名と同じ組にすると
   最もバランスが良くなりそうな参加者を 1 名選ぶ。
 
4. 上記 1 〜 3 で選ばれた参加者 3 名を同じ組にする。
 
5. 上記 4 の 3 名を選択対象から除外し、残りの参加者を対象として
  全ての組のメンバーが決まるまで上記 1 〜 4 を繰り返す。
 
という処理を行なっているに過ぎません。
 
引用:
完璧な結果でとても満足しています。

以上のような仕組み上、後半の組に近づくほど
上記 1 〜 3 において選択対象となる参加者が
減っていくため偏りが生じやすくなります。
必ずしも理想通りの結果を得られるわけではありません。
 
何故にそのようなやり方を例示したのかと言えば、
上位 1 位の参加者には下位 1 位の参加者を、
上位 2 位の参加者には下位 2 位の参加者を……
といった具合にした方が「 3 人目のメンバー」を選ぶ際の
ポイント合計の帳尻合わせがしやすく、またそれらの参加者を
同じ組にした根拠として簡潔で理解しやすいからです。
 
それもあくまで 1 組当たりの人数が 3 人だから通用する話であって、
人数が 4 人以上となった場合はまた「最もバランスが良くなりそうな参加者」を
選ぶ上での根拠や基準を別途考える必要があるでしょう。
 
また、そのイベントがどういった類のものかは分かりませんが、
「各組の各々が持っているポイントの合計が平均になるように」する
という形が本当に適切であるかどうかについても検討の余地があります。
(私自身は「ポイントの合計」ではなく「ポイントの順位」を
組分けの根拠にした方がよいのではないかと考えます)
 
少なくとも「全ての組において、それぞれの組のポイントの合計が
一定の範囲まで近似、収束するまで演算を繰り返す」という手法だと、
扱うデータによっては永遠に演算が終わらなくなる可能性がありますし、
また理想に近い結果を得られたとしても「具体的にどのようなプロセスを経て
そのような結果が導き出されたか」を誰にも説明することができない
(説明できても理解されにくい)事態に陥ってもおかしくはありません。
 
引用:
現在は3人組(ABC)ですが、4人組(ABCD)の場合は、コード中どこを修正すればいいのでしょうか。

引用:
Const BasicMembersCountInTeam As Long = 3

上記の定数の値を変更すれば一応は可能ですが、それだけでは
組分け処理の精度が明らかに落ちることになるでしょう。
 
BasicMembersCountInTeam の値を 4 にした場合、
現在のフローでは上記 2 の処理を 2 回行なってから
上記 3 の処理を行なうことになります。
したがってポイント最上位の参加者は必ずポイント下位 2 名の
参加者達と同じ組にされます。

投稿日時: 24/08/29 15:07:45
投稿者: tako552101

skさん、ありがとうございます。
 
ポイントの合計が各組平均となれば、その方法は問わないので全く問題ありません。また、提示いただいた考え方以外、平均をとる方法を当方も思いつきませんのでこの方法で十分です。
 
今回の使用リスト96名から32組のグループ分けの結果は、差異1が25組、差異2が6、残り1が平均値との差異4でしたので、最初の組分けとしては完璧。あとは目視での作業で合わせるのが楽になりました。
 
また、4人組(後ほど発見しました)でも、ほぼ望み通りの結果が出ています。
 
本当にありがとうございました。