【问题标题】:Select and highlight one random cell using VBA使用 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

【问题讨论】:

    标签: excel vba


    【解决方案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 多年了,所以我有点生疏了。
      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2015-11-24
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多