Есть ли лучший способ заполнить эти несмежные диапазоны моим массивом?

Фото текущего макета листа

У меня есть электронная таблица, которую я написал для управления лигой, и сейчас я переписываю ее целиком для некоторой практики.

Мне было интересно, знает ли кто-нибудь способ сократить действительно повторяющийся цикл, который я написал.

Имена людей, которые регистрируются, указаны в столбце 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

Похоже, у вас есть все «карточки» для каждого игрока в одном большом массиве? Вот почему вам нужно продолжать увеличивать i то, что вы могли бы попробовать, это создать массив массивов?

mtholen 19.11.2022 01:52

@mtholen У меня есть настоящее имя каждого игрока в массиве, который я передаю этому подразделу. Затем эта подпрограмма размещает их на карточках с правой стороны изображения. Однако я никогда не создавал массив массивов, что может сработать, если каждая карта сама по себе является массивом. Я посмотрю на это и посмотрю, смогу ли я заставить что-то работать. На данный момент карты не привязаны к какой-либо переменной. Цикл for перебирает каждую карточку и на данный момент помещает людей на карточках в группы по 4 человека.

AWildRattata 19.11.2022 02:21
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
1
2
59
1
Перейти к ответу Данный вопрос помечен как решенный

Ответы 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

Этот код отлично работает. Я думаю, что смогу адаптировать его к паре других ситуаций, которые случаются с этой конкретной программой, которую я пишу. Спасибо! (Я пытался дать вам положительную репутацию, но это пока не позволяет)

AWildRattata 19.11.2022 04:27

Рад, что смог помочь. Если он ответил на ваш вопрос, просто отметьте ответ как правильный ответ, чтобы помочь ТАК оставаться правильным (т.е. уменьшить количество вопросов без ответа)

mtholen 19.11.2022 04:33

Другие вопросы по теме