當前作業表布局的圖片
我有一個我為管理聯賽而寫的電子表格，并且正在重寫整個程序以進行一些練習。
我想知道是否有人知道一種方法來縮短我寫的真正重復的回圈。
簽到的人在 B 列中有他們的名字。簽到完成后，我用他們的名字填充一個陣列，隨機化，然后將它們放在右側顯示的卡片上。
我的回圈代碼在這里，但不確定是否有更有效的方法。
Sub DivideIntoCards(playerArr As Variant)
Dim i, j As Integer
Dim remainder As Integer
With ActiveSheet
remainder = UBound(playerArr) - LBound(playerArr) 1
If remainder Mod 4 = 0 Then
'Number of players checked in creates equal cards of 4.
Do Until remainder = 0
j = 0
'Fill card #1
If i < 4 Then
For i = 0 To 3
Cells(12 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #2
ElseIf 4 <= i And i < 8 Then
For i = 4 To 7
Cells(12 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #3
ElseIf 8 <= i And i < 12 Then
For i = 8 To 11
Cells(19 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #4
ElseIf 12 <= i And i < 16 Then
For i = 12 To 15
Cells(19 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #5
ElseIf 16 <= i And i < 20 Then
For i = 16 To 19
Cells(26 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #6
ElseIf 20 <= i And i < 24 Then
For i = 20 To 23
Cells(26 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #7
ElseIf 24 <= i And i < 28 Then
For i = 24 To 27
Cells(33 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #8
ElseIf 28 <= i And i < 32 Then
For i = 28 To 31
Cells(33 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #9
ElseIf 32 <= i And i < 36 Then
For i = 32 To 35
Cells(40 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #10
ElseIf 36 <= i And i < 40 Then
For i = 36 To 39
Cells(40 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #11
ElseIf 40 <= i And i < 44 Then
For i = 40 To 43
Cells(47 j, 11) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
'Fill card #12
ElseIf 44 <= i And i < 48 Then
For i = 44 To 47
Cells(47 j, 16) = playerArr(i)
remainder = remainder - 1
j = j 1
Next i
End If
Loop
End If
End With
End Sub
uj5u.com熱心網友回復：
也許試試這個：
Sub DivideIntoCards(playerArr As Variant)
Dim wb As Workbook
Dim ws As Worksheet
Set wb = ThisWorkbook
Set ws = wb.ActiveSheet
Const PLAYER_PER_CARD = 3
Const START_ROW = 12
Const CARD_OFFSET = 7 'offset rows
cols = Array(11, 16) 'set predefined columns
players = UBound(playerArr) - LBound(playerArr) 1
If players Mod PLAYER_PER_CARD = 0 Then
cardCount = CInt(players / PLAYER_PER_CARD) - 1
rPL = START_ROW
For card = 0 To cardCount
m = card Mod 2 'determine odd/even card
If m = 0 Then rPL = START_ROW (card / 2) * CARD_OFFSET 'increase row on uneven cards
cPL = cols(m) 'choose correct column, based on odd/even card
For i = 0 To PLAYER_PER_CARD - 1
plIndex = card * PLAYER_PER_CARD i
ws.Cells(rPL i, cPL) = playerArr(plIndex)
Next i
Next
Else
Response = MsgBox("The player count of " & players & _
" cannot be divided in equals groups of " & PLAYER_PER_CARD & _
" players.", vbCritical, "Player count Error")
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/qukuanlian/536342.html
標籤：擅长VBA
上一篇：獲取特定串列中可用的僅計數值