- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
26#
發表於 2023-2-11 12:05
| 只看該作者
回復 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 |
|
發表於 2023-2-11 13:09
| 