Question

我有麻烦在运行中填充二维数组。

我有一个包含26个名字的列表，并希望将它们随机分成5组5个，其中一个有6个。然后，我想使用每个组将名称写入单独的表格中。我的背景是PHP和JS，因此对阵列进行调暗或重新编辑的需求并不容易。

Dim KlasseA() As String
Dim KlasseB() As String
Dim KlasseC() As String
Dim KlasseD() As String
Dim KlasseE() As String


For i = 1 To 20
   If Sheets(1).Cells(i + 1, 2) <> "" Then      

        pick = ((5 - 1 + 1) * Rnd + 1)

        If pick = 1 Then
            KlasseA(i) = Sheets(1).Cells(i + 1, 3) & ", " & Sheets(1).Cells(i + 1, 2)
        ElseIf pick = 2 Then
            KlasseB(i) = Sheets(1).Cells(i + 1, 3) & ", " & Sheets(1).Cells(i + 1, 2)
        ElseIf pick = 3 Then
            KlasseC(i) = Sheets(1).Cells(i + 1, 3) & ", " & Sheets(1).Cells(i + 1, 2)
        ElseIf pick = 4 Then
            KlasseD(i) = Sheets(1).Cells(i + 1, 3) & ", " & Sheets(1).Cells(i + 1, 2)
        ElseIf pick = 5 Then
            KlasseE(i) = Sheets(1).Cells(i + 1, 3) & ", " & Sheets(1).Cells(i + 1, 2)
        End If
    Else
        Exit For
    End If
Next i

' push the 5 Arrays into a master Array. Use 1 Loop inside a Loop Output the 5 Groups to 5 sheets

我有两个问题：

我如何创造＆＃34;更高＆＃34;数组，我可以将5个较低的数组推入，然后循环遍历所有名称（即最后一个循环而不是5个）。
上面的代码将以非流畅的方式填充子数组，即遗漏了一堆数组索引（由于i）。

理想情况下，我想创建一个2d-Array并在Loop中使用它而不是上面的缺陷解决方法。有人可以建议我吗？

Answer 1

这是样本数据与预期结果在解释情况方面有很大帮助的情况之一。这就是我想象你正在尝试的。

Option Explicit

Sub mcrKlasse()
    Dim Klasse() As Variant
    Dim i As Long, pick As Integer

    ReDim Klasse(1 To 5, 1 To 20)

    With Worksheets(1)
        For i = LBound(Klasse, 2) To UBound(Klasse, 2) 'for 1 to 20
            If CBool(Len(.Cells(i + 1, 2).Value)) Then
                pick = ((5 - 1 + 1) * Rnd + 1)
                Select Case pick
                    Case 1, 2, 3, 4, 5
                        Klasse(pick, i) = Join(Array(.Cells(i + 1, 3), .Cells(i + 1, 2)), ", ")
                End Select
            Else
                Exit For
            End If
        Next i

        'redimension the array in case less than 20 were filled
        ReDim Preserve Klasse(1 To 5, 1 To i - 1)

        'stick them back on the worksheet
        With .Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
            .Resize(UBound(Klasse, 1), UBound(Klasse, 2)) = Klasse
        End With

        'flip them (transpose) and stick them back on the worksheet
        With .Cells(Rows.Count, 2).End(xlUp).Offset(2, 0)
            .Resize(UBound(Klasse, 2), UBound(Klasse, 1)) = _
                Application.Transpose(Klasse)
        End With

    End With

End Sub

代码贯穿数据，但是，我并不完全清楚你要完成的是什么。

二维动态数组

1 个答案: