Question

我正在编写一个VBA代码，该代码经过一个定义的矩阵大小，并在其限制范围内随机填充单元格。

我从stackoverflow上的用户那里得到了代码，但经过测试后我意识到它不适合避免重复填充，例如填充5个单元格时，我只能看到4个单元格填充，这意味着随机在先前填充的细胞上进行填充。

这是我正在使用的代码：

Dim lRandom As Long
Dim sCells As String
Dim sRandom As String
Dim rMolecules As Range
Dim i As Integer, j As Integer
Dim lArea As Long


lArea = 400 '20x20
'Populate string of cells that make up the container so they can be chosen at random
For i = 1 To 20
    For j = 1 To 20
        sCells = sCells & "|" & Cells(i, j).Address
    Next j
Next i
sCells = sCells & "|"

'Color the molecules at random
For i = 1 To WorksheetFunction.Min(5, lArea)
    Randomize
    lRandom = Int(Rnd() * 400) + 1
    sRandom = Split(sCells, "|")(lRandom)
    Select Case (i = 1)
        Case True:  Set rMolecules = Range(sRandom)
        Case Else:  Set rMolecules = Union(rMolecules, Range(Split(sCells, "|")(lRandom)))
    End Select
    sCells = Replace(sCells, "|" & sRandom & "|", "|")
    lArea = lArea - 1
Next i

rMolecules.Interior.ColorIndex = 5

使用完全相同的完全相同的代码，我可以插入什么，我在哪做什么，以便代码检查单元格以前是否已经填充了字符串或颜色？

我觉得好像我正在寻找的代码应该在

之前

rMolecules.Interior.ColorIndex = 5

但我不确定要输入什么。

修改从评论中我意识到我应该更具体。我试图用蓝色随机填充细胞（.ColorIndex = 5），但我需要首先检查的是随机化是否未将细胞标记两次，所以例如在这种情况下，如果我想要标记5个不同的细胞，由于重复而仅标记其中的4个，因此仅填充4个具有蓝色的细胞。我需要避免这种情况，并让它选择另一个标记/填充的单元格。

感谢您的帮助。

Answer 1

为什么不建立一个随机数列表并放在Scripting.Dictionary中，可以使用Dictionary的Exist方法来检测重复项，循环直到你有足够的时间然后你可以输入你的着色代码，相信你有一个独特的清单。

Answer 2

将您使用的单元格保存在Collection中，并在填充随机单元格时将其删除：

Sub FillRandomCells(targetRange As Range, numberOfCells As Long)

    ' populate collection of unique cells
    Dim c As Range
    Dim targetCells As New Collection

    ' make sure arguments make sense
    If numberOfCells > targetRange.Cells.Count Then
        Err.Raise vbObjectError, "FillRandomCells()", _
                "Number of cells to be changed can not exceed number of cells in range"
    End If

    For Each c In targetRange.Cells
        targetCells.Add c
    Next

    ' now pick random 5
    Dim i As Long, randomIndex As Long
    Dim upperbound As Long
    Dim lowerbound As Long

    For i = 1 To numberOfCells
        lowerbound = 1                 ' collections start with 1
        upperbound = targetCells.Count ' changes as we are removing cells we used

        randomIndex = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
        Set c = targetCells(randomIndex)
        targetCells.Remove randomIndex ' remove so we don't use it again!

        c.Interior.Color = 5           ' do what you need to do here
    Next

End Sub

Sub testFillRandomCells()
    FillRandomCells ActiveSheet.[a1:t20], 5
    FillRandomCells ActiveSheet.[b25:f30], 3
End Sub

编辑：更改为使目标范围和已更改单元格的数量可配置为函数的参数。还添加了错误检查（总是这样做！）。

VBA - 通过循环填充单元格时检查重复项

2 个答案: