0

我正在尝试在 VBA 中对一系列单元格执行操作。我希望单元格的选择是随机的，而不是按照范围设置的顺序。

Sub Solver_Step_Evo()
    Set Rng = GetRange(ThisWorkbook.ActiveSheet.Range("Variable_Range"))
    For Each i In Rng
       'perform an action on I where I is randomly selected.
    Next i
End Sub

我的偏好是它随机化顺序，而不仅仅是随机选择一个可以多次选择一个单元格的单元格。

提前致谢。

4

3 回答 3

3

这是一个可能的解决方案。我将相关范围内的所有单元格添加到集合中。然后，我使用随机索引导航集合。访问索引后，我将其从集合中删除并重复该过程。

这对你有用吗？

编辑：无需c.Count为每次迭代调用该方法。我们可以自己解决这个问题。它可能比调用对象的方法更有效。

Sub SuperTester()
    Dim c As Collection
    Dim rng As Range
    Dim cel As Range
    Dim idx As Long
    Dim remainingCount As Long
    
    Set rng = Range("A2:A17")
    Set c = New Collection
    
    For Each cel In rng
        c.Add cel
    Next cel
    
    remainingCount = c.Count
    While remainingCount > 0
        idx = WorksheetFunction.RandBetween(1, c.Count)
        Debug.Print c.Item(idx).Address
        c.Remove idx
        
        remainingCount = remainingCount - 1
    Wend
    
End Sub
于 2020-11-23T18:16:32.307 回答
1

请尝试下一个功能：

Function RndCell(rng As Range) As Range
 Dim rndRow As Long, rndCol As Long
 
 rndRow = WorksheetFunction.RandBetween(1, rng.rows.count)
 rndCol = WorksheetFunction.RandBetween(1, rng.Columns.count)
 Set RndCell = rng.cells(rndRow, rndCol)
End Function

可以使用下一个简单的 sub 对其进行测试：

Sub testSelectRandomCell()
  Dim rng As Range
  Set rng = Range("A2:D10")
  RndCell(rng).Select
End Sub

编辑：

如果随机选择的单元格不应该重复，该函数可以通过下一种方式进行调整（使用Static数组来保留已经选择的单元格）：

Function RndCellOnce(rng As Range, Optional boolClear As Boolean = False) As Range
 Dim rndRow As Long, rndCol As Long, k As Long, El, arr1
 Static arr
 
 If boolClear And IsArray(arr) Then Erase arr
DoItAgain:
    rndRow = WorksheetFunction.RandBetween(1, rng.rows.count)
    rndCol = WorksheetFunction.RandBetween(1, rng.Columns.count)
 If IsArray(arr) Then
    If UBound(arr) = rng.cells.count - 1 Then
        rng.Interior.Color = xlNone
        ReDim arr(0): GoTo Over
    End If
    For Each El In arr
        If El <> "" Then
            arr1 = Split(El, "|")
            If CLng(arr1(0)) = rndRow And CLng(arr1(1)) = rndCol Then GoTo DoItAgain
        End If
    Next El
    ReDim Preserve arr(UBound(arr) + 1)
Else
    ReDim arr(0)
End If
Over:
arr(UBound(arr)) = rndRow & "|" & rndCol
 Set RndCellOnce = rng.cells(rndRow, rndCol)
End Function

可以用下一个 Sub 进行测试。为了直观地检查它，每个选定的单元格都将获得黄色的内部颜色。当所有范围单元格将被选中（一个接一个）时，将擦除静态数组并清除内部颜色：

Sub testSelectRandomCell()
  Dim rng As Range

  Set rng = Range("A2:D10")
  With RndCellOnce(rng)
    .Interior.Color = vbYellow
    .Select
  End With
End Sub
于 2020-11-23T18:39:23.387 回答
1

您可以使用WorksheetFunction.RandBetween获取 2 个数字之间的随机数。这些数字不会是唯一的。如果你想要独一无二，那么你将不得不使用稍微不同的方法。

Option Explicit

Sub Solver_Step_Evo()
    Dim Rng As Range
    
    Set Rng = GetRange(ThisWorkbook.ActiveSheet.Range("Variable_Range"))
    
    Dim lowerBound As Long: lowerBound = 1
    Dim UpperBound As Long: UpperBound = Rng.Cells.Count
    
    Dim randomI As Long
    Dim i As Long
    
    For i = lowerBound To UpperBound
        randomI = Application.WorksheetFunction.RandBetween(lowerBound, UpperBound)
        Debug.Print randomI
    Next i
End Sub
于 2020-11-23T18:17:16.393 回答