[發問] 運動會競賽道次隨機分組

ymes

在下出現一個問題，希望大家能幫;忙：

100M比賽中，一共九個班級，每班二個人參加，想隨機分成三組，每組六人，現情況是：

一、同班不能分在同一組別

二、每班的人不能分在同一道次

麻煩請大家能予以協助，感謝！

Andy2483

回復 32# ymes
回復 19# 准提部林


    再次謝謝前輩發表此主題,謝謝 准提部林前輩指導
後學學習公式的心得,請前輩參考指導,謝謝

下載 (82.21 KB)

2023-2-17 09:55

Andy2483

回復 32# ymes


    恭喜前輩推展順利
請前輩常發表新主題,以弭補對後學的傷害,謝謝前輩
一起學習

ymes

回復 31# Andy2483


抱歉，是真的不會修改vba，所以後續想說請幫忙改動一些小地方，

希望日後有更動時，可以自行修改，

沒想到變成您的困擾……sorry

不過，後續靠著您的幫忙及公式，已完成多項競賽表單，再次說聲感謝！:lol :lol :lol

Andy2483

回復 29# ymes


    謝謝前輩回復
1.學無止盡,雖然有點被前輩耍的感覺,後學甘之如飴,罰前輩繼續發表其他主題給後學們做學習
2. 准提部林前輩的高深回答,後學也還一知半解,請前輩常上論壇一起學習

ymes

回復 24# 准提部林


謝謝大大的提醒，日後以自己熟悉的公式為主，

做自己懂的事也較安全，感謝！

ymes

謝謝二位大神幫忙，其實在第八樓就已經解決在下問題了，
實在是不會修改VBA，所以就不斷發問，
想藉由小部份修改看出日後可能改動的地方，
殊不知造成欲解決者的困擾，真的很抱歉，
再跟網路上幫忙的人說聲感謝，有了您們熱心的幫忙，讓我能順利完成表單，感謝！

Andy2483

回復 27# 准提部林


    謝謝前輩的思路解析指導,後學努力測試領悟中,謝謝前輩提攜

准提部林

回復 26# Andy2483

以下是"思路"解析///
TC = Left(123456789, [k3])  '以跑道數取數字串...跑道有6--道次字串= 123456, 有8則= 12345678
For j = 1 To [k5] - 1: xD(j) = TC: Next '各組都預先置入道次字串
xD(j) = Left(TC, [k4] - ([k5] - 1) * [k3]) '最後一組...若只有4人...則置入 1234

V = Arr(i, 4): TV = xD(V)  ' 取出各組的道次字串(它經過亂數取數後, 會有變化...字元數遞減)

For i = R - 1 To 1 Step -1 '反向迴圈...讓最後一組優先佔用1 ~ ? 跑道, 才不會有間隔

X = Val(Mid(TV, Int(Rnd * Len(TV)) + 1, 1))  '隨機從該組"道次字串"中取出一個數字
If xD(T & "/" & X) = 0 Then Exit Do '以[班級+道次]檢查, 等於0...表示該班級尚未佔用該跑道..合格..跳出//否則重新取數

xD(V) = Replace(TV, X, "") '此次取出的道次數字...須從道次字串中剔除...下次就不會有這個數字(字串每跑一次, 減少一個數)
xD(T & "/" & X) = 1  '[班級&道次]記數為1, 表示該班級已佔用了該跑道(下次排除用)


===========================

Andy2483

回復 19# 准提部林


    謝謝前輩指導,後學駑鈍,這太難了
後學程度只能大概知道程式碼意思,其邏輯意義太難了,後學繼續學習,希望有天能開竅看懂

Sub B_開始分組()
Dim Arr, xD, R&, N&, i&, T$, TC$, TV$, X%, V%, Nx%, j%
'↑宣告變數!(Arr,xD)是通用型變數,(R,N,i)是長整數變數,(T,TC,TV)是字串變數,其他是短整數變數
[k6] = ""
'↑令[K6]儲存格值是空字元
Call 重置資料
'↑執行(重置資料)副程式
R = [m65536].End(3).Row
'↑令R這長整數變數是 M欄最後一個有內容儲存格列號
If R < 2 Then MsgBox "＊尚未載入資料！　": Exit Sub
'↑如果R變數 < 2 !就跳出提示窗~~,按確認後即結束程式執行
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD是 字典
Re_Try:
'↑程序位置識別
Nx = Nx + 1
'↑令Nx這短整數變數累加 1
If Nx > 10 Then MsgBox "＊執行分組多次無結果！請重試或檢查資料是否正確！　": Exit Sub
'↑如果Nx變數 > 10!就跳出提視窗~~,按確認後即結束程式執行
xD.removeall
'↑令xD字典清空
TC = Left(123456789, [k3])
'↑令TC這字串變數是 123456789字串的左側 [k3]值個字
For j = 1 To [k5] - 1: xD(j) = TC: Next
'↑設順迴圈j從1到 [k3]值(跑道數)-1 :令以j變數當key,item是 TC變數,納入 xD字典裡
xD(j) = Left(TC, [k4] - ([k5] - 1) * [k3])
'↑令j變數當key,item是 TC變數左側的 [k4] - ([k5] - 1) * [k3]個字
'=人數 - (組數 - 1)乘上 跑道數
Randomize
'↑不固定亂數初始值
Arr = Range("m2:p" & R)
'↑令Arr這通用型變數是二維陣列,以[M2]到 P欄第 R變數列範圍,
'這範圍儲存格值倒入陣列中
For i = R - 1 To 1 Step -1
'↑設逆迴圈i從 R變數-1 到1 ,令每次迴圈讓i -1
    T = Arr(i, 1)
    '↑令T這字串變數是 i變數列第1欄Arr陣列值
    N = 0
    '↑令N這長整數變數是 0
    V = Arr(i, 4)
    '↑令V這短整數變數是 i變數列第4欄Arr陣列值
    TV = xD(V)
    '↑令TV這字串變數是 以V變數當key查xD字典回傳的item值
    Do
    '↑設無限迴圈! 需要想辦法跳出迴圈!
       X = Val(Mid(TV, Int(Rnd * Len(TV)) + 1, 1))
       '↑令X這短整數變數是 Val函式回傳的數字,
       '函式內容:TV變數從 Int(Rnd * Len(TV)) + 1 個字開始,取1個字
       '亂數 乘 TV變數的字元數後,去除小數,最後 +1
       If xD(T & "/" & X) = 0 Then Exit Do
       '↑如果以 T變數連接 "/" 符號再連接 X變數當key查 xD字典回傳item值是 0??
       '如果是 0,就跳出迴圈
       N = N + 1
       '↑令N變數累加 1
       If N >= 200000 Then GoTo Re_Try
       '↑如果N變數 N >= 200000!,就跳到 Re_Try標示位置繼續執行
    Loop
    xD(V) = Replace(TV, X, "")
    '↑令以V變數當key,item是(TV變數 將X變數以空字元置換)後的字串,納入xD字典
    xD(T & "/" & X) = 1
    '↑令以T變數連接 "/" 再連接 X變數的新字串當key,item是 1,納入xD字典
    Arr(i, 3) = X
    '↑令i迴圈列第3欄Arr陣列值是 X變數
Next i
With [m2].Resize(R - 1, 4)
'↑以下是[M2]擴展向下 R - 1列,向右 4欄範圍儲存格的程序
     .Value = Arr
     '↑令這範圍儲存格值以Arr陣列值倒入
     .Sort Key1:=.Item(4), Order1:=xlAscending, _
           Key2:=.Item(3), Order2:=xlAscending, Header:=xlNo
     '↑令資料以P欄做沒有標題列的順排序,同時做第二層O欄順排序
End With
Application.ScreenUpdating = True: [k6] = "OK"
'↑令螢幕恢復變化: 令[k6] 儲存格值是 "OK" 字串
MsgBox "～分組完成～　"
'↑跳出提示窗~~
End Sub