Выберите и выделите одну случайную ячейку, используя VBA - PullRequest
0 голосов
/ 27 сентября 2019

В настоящее время у меня есть электронная таблица Excel, которая, когда пользователь нажимает кнопку Go, назначает новое случайное число ячейкам на рабочем листе.Значение диапазона составляет от 1 до 500 в матрице 20 на 25.Я хочу случайным образом выбрать и изменить цвет фона на красный только для одной ячейки каждый раз, когда пользователь нажимает кнопку «Перейти».Код ниже в настоящее время назначает случайные числа для ячеек и выбирает и выделяет случайную ячейку.Однако при повторном щелчке по 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

Ответы [ 3 ]

2 голосов
/ 27 сентября 2019

Как упоминалось выше, очистка диапазона цветов перед выделением ячейки является самым быстрым способом.Но если цвета фона ваших ячеек установлены на что-то другое, то должно работать следующее:

Альтернативное решение: Сохраните расположение и цвет ячейки, чтобы выделить ячейку, а затем восстановите ее оригинал.цвет на каждом пробеге.Вы должны объявить местоположение за пределами сабвуфера, чтобы оно не исчезало после его завершения.Это помогло бы, если бы ваши цвета фона были чем-то другим.Проблема в том, что он работает только во время сеанса 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

Напримечание: отправка диапазонов в массив и работа с массивом происходит намного быстрее, но это уже другая тема.Надеюсь, это поможет!

1 голос
/ 27 сентября 2019

Очистите цвет диапазона перед установкой цвета случайной ячейки:

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
0 голосов
/ 27 сентября 2019

Ответ на цветной вопрос.Но есть и другие проблемы в вашем коде, в частности, что ваш shuffle смещен , как объяснено здесь

Вот версия, которая исправляет смещение по модулю, упомянутое в ссылке,вместе с рядом других вопросов

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...