excel 有没有更好的方法用我的数组填充这些不连续的区域?

xam8gpfp  于 2022-11-26  发布在  其他
关注(0)|答案(1)|浏览(161)

Pic of current sheet layout
我有一个电子表格,我写了管理一个联盟,并在重写整个过程中的一些实践。
我想知道是否有人知道一种方法来缩短我写的真正重复的循环。
签到的人在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
2w2cym1i

2w2cym1i1#

也许可以试试这个:

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

相关问题