運動會競賽道次隨機分組 - Excelㄧ般區

　暱稱: 厚臉皮的學生

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

11^# 跳轉到 »

發表於 2023-2-11 09:22 | 顯示全部帖子

回復 21# ymes

謝謝准提部林前輩指導,謝謝前輩一起學習
以下是片段學習心得註解,先提供給前輩參考
此段心得重點在於:用同一陣列濾出符合條件的資料,精確的將資料放入目標儲存格中

Option Explicit
Sub A_載入資料()
Dim Arr, TC$, T$, i&, N&
'↑宣告變數!Arr是通用型變數,(TC,T)是字串變數,(i,N)是長整數變數
Call C_清除
'↑執行(C_清除)副程式
TC = [k2]
'↑令TC這字串變數是 [k2]儲存格值
If TC = "" Then MsgBox "＊未輸入項目名稱！　": Exit Sub
'↑如果TC變數是空字元!就跳出提視窗~~,按確認後即結束程式執行
Application.ScreenUpdating = False
'↑令螢幕暫不隨程式執行作變化
Arr = Range([報名表!c1], [報名表!a65536].End(3))
'↑令Arr這通用型變數是二維陣列,以"報名表"工作表[C1]到A欄最後一個有內容儲存格,
'這範圍儲存格值倒入陣列中
For i = 2 To UBound(Arr)
'↑設順迴圈!i從2到Arr陣列縱向最大索引列號
If Arr(i, 3) = TC Then
'↑如果i迴圈列第3欄Arr陣列值是 TC變數??
   N = N + 1
   '↑令這N長整數變數累加 1
   Arr(N, 1) = Arr(i, 1)
   '↑令N變數列第1欄Arr陣列值是 i迴圈列第1欄Arr陣列值
   Arr(N, 2) = Arr(i, 2)
'↑令N變數列第2欄Arr陣列值是 i迴圈列第2欄Arr陣列值
End If
Next i
If N = 0 Then MsgBox "＊沒有符合項目資料！　": Exit Sub
'↑如果N變數是 0!就跳出提示窗~~,按確認後即結束程式執行
[m2].Resize(N, 4).Value = Arr
'↑令[m2]擴展向下N變數列,向右4欄的範圍儲存格值以Arr陣列值倒入
Call 重置資料
'↑執行(重置資料)副程式
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

12^#

發表於 2023-2-11 10:22 | 顯示全部帖子

回復 19# 准提部林

謝謝前輩
以下心得註解請前輩再指導,謝謝

Sub 重置資料()
Dim R&
'↑宣告變數!R是長整數變數
R = [m65536].End(3).Row
'↑令R這長整數變數是 M欄最後一個有內容儲存格列號
If R < 2 Then Exit Sub
'↑令如果R變數 < 2 !就結束程式執行
Application.ScreenUpdating = False
'↑令螢幕暫不隨程式執行作變化
With Range("m2:p" & R)
'↑以下是關於[M2]到 P欄第 R變數列,這範圍儲存格的程序
   .Columns(3) = "=IF(M2="""",999,COUNTIF(M$1:M2,M2))"
   '↑令這範圍內相對欄位的第3欄(O欄)值是 (公式)字串
   '公式:如果M2是空字元的條件成立,就顯示 999,
   '否則就計算M欄前幾列裡有幾個(當列M欄相同字串)
   .Sort Key1:=.Item(3), Order1:=xlAscending, Header:=xlNo
   '↑令資料以O欄做沒有標題列的順排序
   .Columns(3) = ""
   '↑令這範圍內相對欄位的第3欄(O欄)值是空字元
   .Columns(4) = "=INT((ROW(A1)-1)/K$3)+1"
   '↑令這範圍內相對欄位的第4欄(P欄)值是 (公式)字串,
   '公式:前一列號減1後除以[K3]儲存格值,再去除小數轉化為整數,最後+1
   '用前一列號除的意義是:不會整除,就不必擔心整除不加 1的問題,謝謝前輩
   .Columns(4) = .Columns(4).Value
   '↑令這範圍內相對欄位的第4欄(P欄)值是自身公式計算值
End With
End Sub

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483

　暱稱: 厚臉皮的學生

碩士班 Rank: 5 Rank: 5

帖子: 1567
主題: 40
精華: 0
積分: 1591
點名: 0
作業系統: Windows 7
軟體版本: Excel 2010 & 2016
閱讀權限: 100
性別: 男
來自: 台灣
註冊時間: 2020-7-15
最後登錄: 2026-2-2

13^#

發表於 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

用行動裝置瀏覽論壇學習很方便,謝謝論壇經營團隊
請大家一起上論壇來交流

TOP

Andy2483