如何填充非连续范围？

Question

当前工作表布局

我有一个用于管理联赛的电子表格。我正在重写整个练习。

有没有办法缩短重复循环？

签到的人在 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

Answer 1

也许试试这个：

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