ymes

回復 19# 准提部林


    謝謝您提供另一個想法，vba真的不會，但看到vba這麼方便，都懶得寫公式了……

Andy2483

回復 21# ymes


    謝謝前輩繼續一起學習

1.後學想法不一樣:公式是VBA智慧的精華濃縮,是後學學習EXCEL的里程碑,建議莫忽視公式
2.前輩感受到VBA的好處,以後常上論壇一起學習,讓更多事可以事半功倍
3.前輩陸續增加項目與規則,想必最終版本未定案,以往為同事設計複雜點的表格都要開會討論,
討論各方提出的意見,做出最後的定案
4.後學的經驗是程式寧願寫大一點廣一點,後續做小修改,如果條件像前輩的情境一直變更,程式常常要大改或打掉重寫,
常常改條件對學習中的後學是很好的學習機會,常常變思維,磨耐心,謝謝前輩
5.如果前輩的需求是很急迫的!建議前輩先找可最終定案的團隊一起討論出最終版本,論壇裡很多厲害的前輩可以指導
6.如果需求不急!陸續再提出不同需求討論學習也是很好的方式
7.後學拋磚引玉,,可以得到前輩們的指導,最大的意義是希望更多人一起學習

謝謝論壇,謝謝各位前輩

Andy2483

回復 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

准提部林

回復 20# ymes


一、原本A:C欄分別為班級、姓名、項目，想改成取A:D欄，分別為項目、班級、姓名、學號，要怎麼改動呢？
__看來這還是草槁版本, 一般學號會放在姓名前面吧!  
__項目名稱的"男生/女生"固定放後面? 且只有賽跑項目?
__最好給完整"定案版", 論壇給的是解決方案而不是代工, 自己要能自行更改程式的

二、可以做個分組鈕，讓一鍵完成隨機分組嗎？這樣就不用到各分頁一一去按分組鈕了
__一次各分頁自動完成是可以, 但必須自己要先建立所需分表, 並輸入必要的參數
__各分表都要再次人工檢查驗證正確性, 那麼個別單頁執行也沒啥差別(反正單頁執行並不太花時間)

三、各單項競賽L:N欄原本有驗證資訊，可以像 准提部林大大般，加上分配的組別及道次嗎？
__L:N欄"原本"有驗證資訊---附件沒有看到那"原本"資料??? 那來的?

公式+VBA+工作表基本操作.....有時更有利於表格的製作及處理, 不能偏廢!!!

Andy2483

回復 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

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

准提部林

回復 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

回復 27# 准提部林


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

ymes

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

ymes

回復 24# 准提部林


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

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