[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『ランダムに担当を割り当てたい』（comaya）
以下の様なことをやりたいのですが、方法がわからず、ご教示頂けると幸いです。
A列：完了者、B列：担当者が一致している場合、別の確認者（D列）を割り当てたいと考えています。
確認者（D列）はB列に載ってる人以外の人にしたいです。
C列が×の場合、B列記載の人以外の人を、E列の担当者リストからランダムに割り当てる式をD列に入れたいのですが、どの様にすればよいのでしょうか？
A B C Ｄ Ｆ 1 完了者 担当者 確認 確認者 担当者リスト 2 佐藤 佐藤 × 鈴木 佐藤 3 佐藤 鈴木 〇 鈴木 4 鈴木 鈴木 × 田中 田中 5 田中 田中 × 安田 佐々木 6 佐々木 佐々木 × 山田 山田 7 佐々木 山田 〇 藤田 8 山田 山田 × 後藤 9 山田 安田 〇 長谷川 10 山田 山田 × 長谷川 安田 11 藤田 佐藤 〇 12 藤田 鈴木 〇 13 後藤 後藤 × 藤田 14 長谷川 安田 〇 15 長谷川 長谷川 × 後藤 16 安田 安田 × 佐々木 17 安田 安田 × 佐藤
どうぞ宜しくお願い致します。
＜ 使用 Excel：Excel2019、使用 OS：Windows10 ＞
以下、質問・気になる点
・C列が"×"の時に確認者を求める(D8に値が入っていないがミス？)
・D列には同行のB列以外の値が入る
→A列とB列が一致～とあるが、この条件は関係ない？結局Bとは別の値が入るから。
（w） 2021/08/06(金) 08:58
ランダムにということは、
多数回実行すると平均的には均等に確認者を指定することになりますが、
場合によっては、同じ確認者が何度もでてきてしまうことがありうるわけです。
（サイコロを振ったとき、同じ目が続くことがあっても、それはランダムなわけです。
それと同様、これもランダムなわけです。）
そうではなくて、確認者は均等にして欲しい、
完了、担当、確認は同一数になって欲しいんです、
などということが議論すると出てくる、というのは結構ある話なんです。
あらためて、そのあたりの条件があるのかどうか、確認しておいたほうが議論はしやすいでしょう。
（γ） 2021/08/06(金) 09:37
ｗ様のご質問に回答させて頂きます。
・C列が"×"の時に確認者を求める(D8に値が入っていないがミス？)
⇒すみません。ミスです。C列が×の時に確認者を求めたいです。
・D列には同行のB列以外の値が入る
→A列とB列が一致～とあるが、この条件は関係ない？結局Bとは別の値が入るから
⇒ご理解の通りです。C列が×（A列とB列が一致）の時だけ、D列にB列に記載の人以外が入れば良いです。
（不一致の場合でも、D列にB列以外の人が入っても良いのですが、以下の人毎の割当件数からは除外したいです）
y様のランダムに・・という点ですが、B列とD列には必ず別の人が入るというのが希望です。
そしてD列に割り当てられる人毎の件数がほぼ同一であって欲しいです（上記の例の様にバラバラに割り当たるのが理想で、佐藤さんは5件だけど、田中さんは0件とはならない様にしたいです）
どうぞ宜しくお願い致します。
（comaya） 2021/08/06(金) 13:24
数式だと難しそうですね。
VBAでも面倒な処理になりそうですが、vbaは不都合ですか？
（w） 2021/08/06(金) 13:42
VBAでも大丈夫です。
面倒をお掛けして申し訳ありません。
（comaya） 2021/08/06(金) 13:46
完了者・担当者・確認 のデータが全て入力されてから確認者の割り振りをするのでしょうか？
それとも，完了者・担当者・確認のデータが追加されて，その都度割り振りするのでしょうか？
後者の場合均等な割り振りの処理が，私にとっては難しいです。
ただ割り振るだけならできますが・・・
（no_name） 2021/08/06(金) 13:54
完了者・担当者・確認のデータは毎日更新されます。確認者（D列）に毎日割り振りしたいです。
理想を言うと、1日目にAさん、Bさん、Cさんに割り当てられたら、2日目はそれ以外の人が割り当てられ
1か月単位とかまとまって見た時に件数がほぼ同一となっている方が良いです（でも難しそうですよね・・・）
宜しくお願い致します。
（comaya） 2021/08/06(金) 14:37
「１日目に～2日目に～」らへんの話は、後出しなので考慮してません。
(そもそも日付データなんてないですし)
私も、初心者に毛が生えたようなものなので、コードをレビューしてほし(ry
Option Explicit
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.Sheets("担当")
Dim arr() As String, tanto As String
Dim lastRow As Long, i As Long, idx As Long
Dim arrBk As Variant
'担当者リストを配列に
lastRow = ws.Cells(Rows.Count, 5).End(xlUp).Row
ReDim arr(lastRow - 2)
For i = 2 To lastRow
arr(i - 2) = ws.Cells(i, 5).Value
Debug.Print "arr(" & i - 2 & "): " & arr(i - 2)
Next
'バックアップ
arrBk = arr
'値設定範囲の特定
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lastRow
'C列が×か
If ws.Cells(i, 3).Value = "×" Then
'担当者リストから確認者の選定
Do
Debug.Print "idx: " & idx & " arrMax: " & UBound(arr)
idx = Int((UBound(arr) + 1) * Rnd + 0)
If arr(idx) <> ws.Cells(i, 2).Value Then
ws.Cells(i, 4).Value = arr(idx)
If UBound(arr) > 0 Then
Call remArr(arr, idx)
Else
'バックアップを戻すよ
ReDim arr(UBound(arrBk))
arr = arrBk
End If
Exit Do
End If
Loop
End If
Next
End Sub
Sub remArr(ByRef arr As Variant, ByVal idx As Long)
Dim i As Long
For i = idx To UBound(arr) - 1
arr(i) = arr(i + 1)
Next
ReDim Preserve arr(UBound(arr) - 1)
End Sub
（w） 2021/08/06(金) 17:05
'担当者リストから確認者の選定
Do
Debug.Print "idx: " & idx & " arrMax: " & UBound(arr)
idx = Int((UBound(arr) + 1) * Rnd + 0)
If arr(idx) <> ws.Cells(i, 2).Value Then
ws.Cells(i, 4).Value = arr(idx)
If UBound(arr) > 0 Then
Call remArr(arr, idx)
Else
'バックアップを戻すよ
ReDim arr(UBound(arrBk))
arr = arrBk
End If
Exit Do
ElseIf UBound(arr) = 0 Then
'割り当て最終者が担当者とかぶってしまった！
'バックアップを戻すよ
Dim nokori As String
nokori = arr(idx)
ReDim arr(UBound(arrBk) + 1)
arr = arrBk
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = nokori
End If
Loop
（w） 2021/08/06(金) 17:15
（comaya） 2021/08/06(金) 18:18
こんばんは！ 乱数で担当者リストを作って採用される度に出現回数をプラスしていきます。 出現回数の少ない順に採用されていくはず？です。
Option Explicit
Sub てすと()
Dim MyScs As Object
Dim MyDic As Object
Dim 担当者 As Variant
Dim v As Variant
Dim i As Long
Dim n As Long
Set MyScs = CreateObject("System.Collections.SortedList")
Set MyDic = CreateObject("Scripting.Dictionary")
担当者 = Range("E2", Range("E" & Rows.Count).End(xlUp)).Value
v = Range("A1", Range("A" & Rows.Count).End(xlUp)).Resize(, 4).Value
Randomize
For i = LBound(担当者, 1) To UBound(担当者, 1)
MyScs(Rnd()) = 担当者(i, 1)
Next
For i = LBound(v, 1) + 1 To UBound(v, 1)
If v(i, 3) = "×" Then
For n = 0 To MyScs.Count - 1
If MyScs.GetByIndex(n) <> "" Then
If v(i, 2) <> MyScs.GetByIndex(n) Then
MyDic(MyScs.GetByIndex(n)) = MyDic(MyScs.GetByIndex(n)) + 1
MyScs(MyDic(MyScs.GetByIndex(n)) + Rnd()) = MyScs.GetByIndex(n)
v(i, 4) = MyScs.GetByIndex(n)
MyScs.Remove MyScs.GetKey(n)
Exit For
End If
End If
Next
End If
Next
Range("G:J").Clear
Range("G1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
Set MyScs = Nothing
Set MyDic = Nothing
Erase 担当者, v
End Sub
新しいキーは出現回数を別でカウントする様にしました。m(__)m
（SoulMan） 2021/08/06(金) 23:20
すっかり遅くなってしまって申し訳ありません。
無事ランダムに割り当てられているけど、件数はほぼ同一という状態になりました。
データを追加しても同様です。
どうもありがとうございました！
（comaya） 2021/08/11(水) 10:46
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.