- 帖子
- 1425
- 主題
- 40
- 精華
- 0
- 積分
- 1449
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-4-16
|
本帖最後由 Andy2483 於 2023-2-9 08:56 編輯
回復 7# ymes
謝謝前輩再回復
1.後學複習了一下,做了註解,請前輩參考
2.如果跑道數,每班人數,同班不同道這些條件導致隨機組合無解!! 該如何設計才能判定無解?? 並跳出 "無解" 提視窗後結束程序??
例如:每班人數4人會導致無解,請前輩們指導,謝謝
Option Explicit
Sub TEST_1()
Dim Drr, Brr, Crr, Y, 亂數&, 人數&, 道數&, 組數&, 執行數&, 跑道數&, i&
Dim 項目$, Arr(1 To 1000, 1 To 3), n&, m&
'↑宣告變數:(Drr, Brr, Crr, Y)是通用型變數,項目 是字串變數,Arr是二維陣列,
'其他是長整數變數
項目 = Split(ActiveSheet.Name, "(")(0)
'↑令 項目 這字串變數是 以"("符號 將工作表名分割成一維陣列取0索引號的字串
跑道數 = [A3].End(xlDown).Row - 2
'↑令 (跑道數) 這長整數變數是 從[A3]儲存格往下找到空格的前一格列號 - 2
Drr = Range([報名表!C2], [報名表!A65536].End(3))
'↑令 Drr這通用型變數 是二維陣列,以報名表[C2]到A欄最後一個有內容儲存格值倒入
For i = 1 To UBound(Drr)
'↑設順迴圈!從1到 Drr陣列縱向最後索引號
If Drr(i, 3) Like 項目 & "*" Then
'↑如果i迴圈數第3欄Drr陣列值是 (項目)變數 開頭的字串??
n = n + 1
'↑令n這長整數變數 累加1
Arr(n, 1) = Drr(i, 1): Arr(n, 2) = Drr(i, 2): Arr(n, 3) = Drr(i, 3)
'↑令n變數列第1欄Arr陣列值是 i變數列第1欄Drr陣列值,~~依此類推
End If
If InStr(Cells(i, 1), 項目) Then Cells(i, 2).Resize(1, 2).ClearContents: m = m + 1
'↑如果工作表i變數列第1欄儲存格值 包含了(項目)變數字串!就清除右側兩儲存格的內容,
'令m這長整數變數累加1
Next
If n = 0 Then
'↑如果n變數是 0?
MsgBox "沒有名單!無法執行": Exit Sub
'↑跳出提示窗~"沒有名單!無法執行"~,之後結束程式執行
End If
If m < n Then
'↑如果 m變數小於 n變數?
MsgBox "組數表格不夠!無法執行": Exit Sub
'↑跳出提示窗~"組數表格不夠!無法執行"~,之後結束程式執行
End If
[L:N].ClearContents: [L1].Resize(n, 3) = Arr
'↑令[L:N]這3欄儲存格內容清除 :令[L1]擴展向下n變數列,向右擴展3欄的範圍儲存格以Arr陣列值倒入
人數 = n: ReDim Brr(跑道數 - 1, 1)
'↑令 人數這長整數變數是 n變數值: 宣告Brr陣列大小(縱向從0到 跑道數-1,橫向從0到 1)
Head:
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y是 字典
Do While 執行數 < 人數
'↑設條件迴圈:當 (執行數)變數 < (人數)變數!就繼續執行!
Randomize: 亂數 = Rnd() * 10000 Mod 人數 + 1
'↑令 亂數這長整數變數是 1 到 (人數)變數的Rnd()亂數值
If Y.Exists(亂數) = Empty Then
'↑如果產生的(亂數)變數值沒有在Y字典裡?
執行數 = 執行數 + 1
'↑令(執行數)這長整數變數 累加1
Y(亂數) = ""
'↑令(亂數)變數當key,item是空字元放入Y字典
道數 = 執行數 Mod 跑道數
'↑令(道數)這長整數變數是 (執行數) 除 (跑道數) 的餘數
Y(Arr(亂數, 1) & "|" & 道數) = ""
'↑令(亂數)變數列第1欄Arr陣列值 連接 "|" 再連接 (道數)變數的組合字串當key,item是空字元放入Y字典
組數 = IIf(道數, 執行數 \ 跑道數 + 1, 執行數 \ 跑道數)
'↑令(組數)這長整數變數是 以IIf()判斷的回傳值,
'如果(道數)變數不是0,就令(組數)變數是 (執行數)變數 除 (跑道數)的商取整數後 + 1
'如果(道數)變數是0,就令(組數)變數是 (執行數)變數 除 (跑道數)的商取整數
Y(Arr(亂數, 1) & "/" & 組數) = ""
'↑令(亂數)列第1欄Arr陣列值 連接 "/" 再連接 (組數)變數的組合字串當key,item是空字元放入Y字典
Crr = Y(組數 & "/組")
'↑令Crr這通用型變數是 以(組數)變數 連接 "/組"成的組合字串當key,查Y字典得到的item
If Not IsArray(Crr) Then
'↑如果Crr變數不是陣列?
Crr = Brr
'↑令Crr 是 Brr陣列
End If
道數 = IIf(道數, 道數, 跑道數)
'↑令(道數)變數是 以IIf()判斷的回傳值,
'如果(道數)變數不是0!就令(道數)變數是 (道數)變數
'如果(道數)變數是0!就令(道數)變數是 (跑道數)變數
Crr(道數 - 1, 0) = Arr(亂數, 1): Crr(道數 - 1, 1) = Arr(亂數, 2)
'↑令(道數)變數-1索引號列第0索引號欄Crr陣列值是 (亂數)變數列第1欄Arr陣列值
'↑令(道數)變數-1索引號列第1索引號欄Crr陣列值是 (亂數)變數列第2欄Arr陣列值
Y(組數 & "/組") = Crr
'↑令以(組數)變數連接 "/組" 的組合字串當key,item是 Crr陣列,放入Y字典
'如果該key已存在Y陣列!就取代其item
End If
If (Y.Count - 組數) Mod 執行數 Then
'↑如果(Y字典key數量 - (組數)變數) 除 (執行數)變數的餘數不是0?
組數 = 0
'↑令(組數)變數是 0
執行數 = 0
'↑令(執行數)變數是 0
GoTo Head
'↑跳到 Head標示處繼續執行
End If
Loop
'↑跳到 Do 位置繼續執行
For i = 1 To 組數
'↑設順迴圈!i從1到 (組數)變數
[B3].Item((i - 1) * (跑道數 + 3) + 1, 1).Resize(跑道數, 2) = Y(i & "/組")
'↑[B3]儲存格擴展向下(跑道數)變數列,向右擴展2欄範圍儲存格以 陣列值 倒入,
'陣列值是:以 i迴圈數 連接 "/組"的組合字串當key,查Y字典得到的item
Next
End Sub |
|
發表於 2023-2-7 09:28
| 
