使用 VBA 选择并突出显示一个随机单元格

Posted 2023-03-27

【中文标题】使用 VBA 选择并突出显示一个随机单元格

【英文标题】：Select and highlight one random cell using VBA

【发布时间】：2020-01-27 06:35:21

【问题描述】：

我目前有一个 Excel 电子表格，当用户单击“Go”时，它会为工作表中的单元格分配一个新的随机数。范围值在 20 x 25 矩阵中的 1 到 500 之间。每次用户单击“开始”按钮时，我只想随机选择一个单元格的背景颜色并将其更改为红色。下面的代码当前正在为单元格分配随机数并选择并突出显示随机单元格。但是，当再次单击 Go 时，先前选择的单元格仍然与新选择的单元格一起突出显示。如何在单击 Go 时将其编码为仅突出显示新选择的单元格？

Public Sub GenerateRandom()
    Set MyRange = Range("C4:AA23")
        For i = 1 To 500
            MyRange.Cells(i) = i
        Next
        For Each Cell In MyRange
            swapcell = 1 + Int(Rnd * 500)
            savedValue = Cell.Value
            Cell.Value = MyRange.Cells(swapcell).Value
            MyRange.Cells(swapcell) = savedValue
        Next

       With MyRange.Cells(1 + Int(Rnd * 500))
                MyRange.Cells(RndBetween(1, 500)).Interior.Color = vbRed        
      End With        
    End Sub

    Public Function RndBetween(ByVal Low, ByVal High) As Integer
       Randomize
       RndBetween = Int((High - Low + 1) * Rnd + Low)
    End Function

【参考方案1】：

如上所述，在突出显示单元格之前清除范围颜色是最快的方法。但是，如果您的单元格的背景颜色设置为其他颜色，那么以下应该可以工作：

替代解决方案： 存储单元格的位置和颜色以突出显示单元格，然后在每次运行时恢复其原始颜色。您将声明子外部的位置，以便在子结束后它不会消失。如果您的背景颜色是其他颜色，这将有所帮助。问题在于它仅在 Excel 会话期间有效，如果您关闭并保存该位置将会丢失，除非您将其保存到隐藏的工作表中 = 此任务不必要的复杂性。

    Dim OriginalCell As Range
    Dim OriginalCol

    Public Sub GenerateRandom()

    Dim myRange As Range
    Dim NewCell As Range

    Set myRange = Range("C4:AA23")

    For i = 1 To 500
        myRange.Cells(i) = i
    Next

    For Each Cell In myRange
        swapcell = 1 + Int(Rnd * 500)
        savedValue = Cell.Value
        Cell.Value = myRange.Cells(swapcell).Value
        myRange.Cells(swapcell) = savedValue
    Next

    ''''new code
    Set NewCell = myRange.Cells(RndBetween(1, MyRange.Cells.Count))

    If OriginalCell Is Nothing Then
        Set OriginalCell = NewCell
        OriginalCol = OriginalCell.Interior.Color
    Else
        OriginalCell.Interior.Color = OriginalCol
        Set OriginalCell = NewCell
        OriginalCol = OriginalCell.Interior.Color
    End If

    NewCell.Interior.Color = vbRed
    '''''

    End Sub

附带说明，将范围发送到数组并使用数组要快得多，但这是另一个主题。希望这会有所帮助！

【参考方案2】：

在设置随机单元格颜色之前清除范围颜色：

Public Sub GenerateRandom()
    Set Myrange = Range("C4:AA23")
        For i = 1 To 500
            Myrange.Cells(i) = i
        Next
        For Each Cell In Myrange
            swapcell = 1 + Int(Rnd * 500)
            savedValue = Cell.Value
            Cell.Value = Myrange.Cells(swapcell).Value
            Myrange.Cells(swapcell) = savedValue
        Next

       Myrange.Interior.Color = xlNone
       With Myrange.Cells(1 + Int(Rnd * 500))
                Myrange.Cells(RndBetween(1, 500)).Interior.Color = vbRed
      End With
    End Sub

    Public Function RndBetween(ByVal Low, ByVal High) As Integer
       Randomize
       RndBetween = Int((High - Low + 1) * Rnd + Low)
    End Function

【讨论】：

谢谢。我应该知道这将是一件简单的事情。 SMH。

【参考方案3】：

颜色问题已得到解答。但是您的代码中还有其他问题，特别是您的随机播放是有偏见的，正如here

所解释的那样

这是一个修复链接中提到的模偏差以及其他一些问题的版本

Public Sub GenerateRandom()
    'declare variables
    Dim MyRange As Range, Cell As Range
    Dim i As Long
    Dim swapcell As Long, savedValue As Long
    Dim idx As Long

    Randomize 'only need this once
    Set MyRange = ActiveSheet.Range("C4:AA23") 'or specify a specific sheet
    For i = 1 To MyRange.Cells.Count ' link size to specified range
        MyRange.Cells(i) = i
    Next
    For idx = MyRange.Cells.Count To 1 Step -1
        swapcell = RndBetween(1, idx) 'remove modulo bias
        savedValue = MyRange.Cells(idx).Value
        MyRange.Cells(idx).Value = MyRange.Cells(swapcell).Value
        MyRange.Cells(swapcell) = savedValue
    Next

    MyRange.Interior.Color = xlNone 'remove colour
    'removed unused With block
    MyRange.Cells(RndBetween(1, MyRange.Cells.Count)).Interior.Color = vbRed
End Sub

'declare types
Public Function RndBetween(ByVal Low As Long, ByVal High As Long) As Long
    RndBetween = Int((High - Low + 1) * Rnd + Low)
End Function

【讨论】：

谢谢！我很欣赏上面的链接。我用 VBA 编码已经 10 多年了，所以我有点生疏了。