excel - 随机分布到一个矩阵

Question

我有一个矩阵，比如说 5 列和 10 行。
然后我有30颗星。我想将它们放入矩阵中，使每行上的星数相同，每列上的星数相同(每行 3 星，每列 6 星)。
如果我有 40 颗星，那么每行应该有 4 颗星，每列应该有 8 颗星。
我可以手动做矩阵，我真的做了这两种情况。但是矩阵越大，我越难以填充星星。
我想它背后应该有一个原则，但仍然没有弄清楚。
我在 Excel 中使用 VBA 生成具有 30 颗星的 5x10 矩阵，但是通过循环尝试所有可能性需要几分钟。

Sub test()
   Dim xRange As Range
   Set xRange = Selection
   GoTo FillX
   GoTo CheckRows
   FillX:
      xRange.Clear
      xRange.HorizontalAlignment = xlCenter
      For i1 = 1 To 5
         For i2 = 1 To 6
            v = Int(Rnd() * 10 + 1)
            While xRange.Cells(v, i1).Value = "x"
               v = Int(Rnd() * 10 + 1)
            Wend
            xRange.Cells(v, i1).Value = "x"
         Next
      Next
   CheckRows:
      x = 0
      For Each Row In xRange.Rows
         If WorksheetFunction.CountA(Row) <> 3 Then
            x = x + 1
         End If
      Next
      While x <> 0
         GoTo FillX
         GoTo CheckRows
      Wend
End Sub

有没有一种解决方案可以将星星随机分布到任意大小的范围内？

Answer 1

应该避免转到。改用循环。
此代码首先计算每行的星数，然后使用嵌套循环输入它们，因此一行中永远不会有更多星。通过跳到下一行，但保留列位置，然后从第一列的同一行开始，您可以确保一列中的星数不超过定义的数量。空白单元格将从左上到右对角线移动。您可以在应用条件格式时看到这一点。
使用这种模式，您无需反复试验，代码运行速度非常快。

Sub test()

Dim gridRows As Long, gridColumns As Long, Stars As Long
Dim myRow As Long, myColumn As Long
Dim i As Long, j As Long
Dim rowCounter As Long, columnCounter As Long, rowOffset As Long
Dim ws As Worksheet

Set ws = Me


'You can get the grid rows and columns and the number of stars from
' user input or from worksheet cells in you want. Just make sure
' they end up in the variables below.

gridRows = 20
gridColumns = 10
Stars = 60

mycolumns = Stars / gridRows
myRows = Stars / gridColumns
j = 1
rowCounter = 1
columnCounter = 1
ws.Range("A1:zz9990").ClearContents


For j = 1 To gridRows
    rowOffset = 0
    For i = 1 To gridColumns
        ws.Cells(j, i) = 1
        columnCounter = columnCounter + 1
        If columnCounter > mycolumns Then
            j = j + 1
            columnCounter = 1
            rowOffset = 1
        End If
    Next i
    j = j - rowOffset
Next j

' randomize the results
Dim SortRange As Range

' randomize the columns
Set SortRange = ws.Range(ws.Cells(gridRows + 1, 1), ws.Cells(gridRows + 1, gridColumns))

' enter random numbers
For Each cel In SortRange
    Debug.Print cel.Address
    cel.Value = Rnd
Next cel

' sort left to right
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add2 Key:=SortRange _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
    .SetRange Range("A1", Cells(gridRows + 1, gridColumns))
    .Header = xlGuess
    .Orientation = xlLeftToRight
    .SortMethod = xlPinYin
    .Apply
End With

' clear the random numbers
SortRange.ClearContents

Set SortRange = ws.Range(ws.Cells(1, gridColumns + 1), ws.Cells(gridRows, gridColumns + 1))

' randomize the rows
' enter random numbers
For Each cel In SortRange
    Debug.Print cel.Address
    cel.Value = Rnd
Next cel

'Sort Rows
ws.Sort.SortFields.Clear
ws.Sort.SortFields.Add2 Key:=SortRange _
    , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ws.Sort
    .SetRange Range("A1", Cells(gridRows, gridColumns + 1))
    .Header = xlGuess
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With

' clear the random numbers
SortRange.ClearContents

End Sub

评论后编辑:添加代码以随机化结果。在表的末尾添加一行带有随机数的行，按这些随机数从左到右排序，然后再次删除它们。对一列随机数执行相同操作并从上到下排序，然后删除辅助数字。
屏幕截图显示了一个包含 20 行、10 列和 60 颗星的网格，使用条件格式可以更好地显示分布。
一个有 60 行、30 列和 1200 颗星的网格只需不到一秒的时间就可以构建(不使用条件格式)。