Как выбрать случайную пустую ячейку из диапазона ячеек, пока не будут выбраны все ячейки в диапазоне?

Question

Впервые VBA кодер здесь, так что я не совсем уверен, с чего начать.

Я создаю «тест», в котором макрос выбирает случайную пустую ячейку в заданном диапазоне (C9: 014). Затем пользователь вводит что-то в ячейку и нажимает Enter. Затем макрос выбирает другую пустую ячейку в заданном диапазоне (C9: O14). Пользователь снова вводит что-то в выбранную ячейку и нажимает Enter. Этот процесс повторяется до тех пор, пока все 78 ячеек в диапазоне не будут заполнены пользователем.

Я подозреваю, что это что-то вроде До тех пор, пока не будет задействовано l oop.

У кого-нибудь есть идеи, как это сделать?

Большое спасибо, ребята.

Answer 1

на панели кода рабочего листа (щелкните правой кнопкой мыши на вкладке и выберите «Просмотреть код»), введите следующее

Option Explicit

Dim quizRng As Range
Dim coll As Collection
Dim i As Long

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not quizRng Is Nothing Then If WorksheetFunction.CountBlank(quizRng) > 0 Then SelectCell Else MsgBox "game over"        
End Sub

Sub Start()
    Set quizRng = Range("C9:O14")
    With quizRng
        SetColl .Cells
        .ClearContents
        i = 0
    End With
End Sub

Sub SelectCell()
    Dim n As Long        
    With quizRng
        If coll.Count = 0 Then Exit Sub
        i = i + 1
        n = Int(1 + Rnd * (coll.Count))
        .Cells(coll(n)).Select

        coll.Remove n
    End With        
End Sub

Sub SetColl(rng As Range)
    Set coll = New Collection
    Dim i As Long
    For i = 1 To rng.Count
         coll.Add i
    Next
End Sub

Затем добавьте кнопку на свой лист и назначьте ей Start macro

Пользователь должен будет нажать кнопку, чтобы начать игру, а затем просто записать в ячейки, которые прогрессивно выбираются кодом, до сообщения «game over»

Edit

в качестве альтернативы кнопке, как в ответе @ AbdallahEl-Yaddak, ее можно запустить, просто активировав лист, добавив следующий код

Private Sub Worksheet_Activate()
    MsgBox "Start of the game!"
    Start
End Sub

Изменить 2

изменено

.Cells(m \ .Columns.Count + IIf(m Mod .Columns.Count = 0, 0, 1), IIf(m Mod .Columns.Count = 0, .Columns.Count, m Mod .Columns.Count))

до

.Cells(coll(n)).Select

благодаря @ AbdallahEl-Yaddak

Answer 2

Добро пожаловать на борт!

Используя этот код:

1. Игра начинается после активации листа.
2. Игрок не может изменить сделанный выбор по коду.

Сначала добавьте этот код в модуль рабочего листа (в области кода рабочего листа (щелкните правой кнопкой мыши на вкладке и выберите «Просмотреть код») и введите следующее):

Private Used_Range As Range, Quiz_Range As Range, ThisCell As Range, PreventSelect As Boolean

Private Sub Worksheet_Activate()
    FreshStart
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long, nMax As Long
    OnError GoTo ex
    Application.EnableEvents = False
    If Quiz_Range Is Nothing Then FreshStart
    If Not Used_Range Is Nothing Then
        If Used_Range.Address = Quiz_Range.Address Then
            If MsgBox("Game Over!" & Chr(10) & "Do you want to start over?", vbYesNo) = vbYes Then
                FreshStart
            Else
                GoTo ex
            End If
        End If
    End If
    nMax = Quiz_Range.Cells.Count
    n = RandBetween(1, nMax)
    If Used_Range Is Nothing Then
        Set ThisCell = Quiz_Range.Cells(n)
        Set Used_Range = ThisCell
    Else
        Do Until Intersect(Quiz_Range.Cells(n), Used_Range) Is Nothing
            n = n + 1
            If n > nMax Then n = 1
        Loop
        Set ThisCell = Quiz_Range.Cells(n)
        Set Used_Range = Union(Used_Range, ThisCell)
    End If
    Quiz_Range.Cells(n).Select
ex:
    Application.EnableEvents = True
    PreventSelect = False
End Sub
Function RandBetween(MinInt As Long, MaxInt As Long) As Long
    RandBetween = Int((MaxInt - MinInt + 1) * Rnd + MinInt)
End Function
Sub FreshStart()
    Set Used_Range = Nothing
    Set Quiz_Range = Range("C9:O14")
    Quiz_Range.ClearContents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If PreventSelect Then
        ThisCell.Select
        MsgBox "You can't select another cell!"
    End If
    PreventSelect = True
    Application.EnableEvents = True
End Sub

Примечание. Этот случайный селектор выбирает следующую неиспользуемую ячейку, если выходные данные функции Rnd ссылаются на используемую ячейку.

---

Edit # 1

Используя метод рандомизации @HTH, код может быть намного лучше:

Private coll As Collection, Quiz_Range As Range, ThisCell As Range, PreventSelect As Boolean
Private Sub Worksheet_Activate()
    FreshStart
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim n As Long, nMax As Long, m As Long
    OnError GoTo ex
    Application.EnableEvents = False
    If Quiz_Range Is Nothing Then FreshStart
    If coll.Count = 0 Then
        If MsgBox("Game Over!" & Chr(10) & "Do you want to start over?", vbYesNo) = vbYes Then
            FreshStart
        Else
            GoTo ex
        End If
    End If
    n = Int(1 + Rnd * (coll.Count))
    Quiz_Range.Cells(coll(n)).Select
    coll.Remove n
ex:
    Application.EnableEvents = True
    PreventSelect = False
End Sub
Sub FreshStart()
    Set Quiz_Range = Range("C9:F14")
    SetColl Quiz_Range
    Quiz_Range.ClearContents
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Application.EnableEvents = False
    If PreventSelect Then
        ThisCell.Select
        MsgBox "You can't select another cell!"
    End If
    PreventSelect = True
    Application.EnableEvents = True
End Sub
Sub SetColl(rng As Range)
    Set coll = New Collection
    Dim i As Long
    For i = 1 To rng.Count
         coll.Add i
    Next
End Sub

Answer 3

Укажите название диапазона (в котором вы будете играть в игру) в ячейке A1.

Sub quiz()
    Dim ws As Worksheet, target As Range
    Set ws = ThisWorkbook.Worksheets("Sheet1")
    Set target = ws.Range(ws.Range("A1").Value)
    Total = target.Rows.Count * target.Columns.Count
    random = Rnd(Total)
    For Each cell In target
    If cell.Value = "" Then
    cell.Select
        If cell.Row * cell.Column = random Then
        Exit For
        End If
    End If
    Next cell
    End Sub

Answer 4

Предполагается, что все ячейки в блоке изначально пусты:

Sub JustaGame()
    Dim rng As Range, arr(1 To 78) As Variant
    Set rng = Range("C9:O14")

    i = 1
    For Each r In rng
        arr(i) = r.Address(0, 0)
        i = i + 1
    Next r

    Call Shuffle2(arr)
    For i = 1 To 78

        addy = arr(i)
        v = Application.InputBox(Prompt:="Please enter a value for cell " & addy, Type:=2)
        Range(addy) = v
    Next i
End Sub

Public Sub Shuffle2(InOut() As Variant)
    Dim o As Object, oc As Long, i As Long, io
    Dim j As Long, k As Long

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim helper(Low To Hi) As Variant
    Randomize


    Set o = CreateObject("System.Collections.ArrayList")
    For Each io In InOut
        o.Add io
    Next io

    j = Low
    oc = o.Count - 1
    For i = 1 To oc
        k = Int((o.Count - 1 - 0 + 1) * Rnd() + 0)
        helper(j) = o.Item(k)
        j = j + 1
        o.RemoveAt k
    Next i

    helper(j) = o.Item(0)

    For j = Low To Hi
        InOut(j) = helper(j)
    Next j

    Set o = Nothing
End Sub

Примечание:

1. arr() - полный список адресов в блоке
2. Shuffle2() создает случайную перестановку этого списка
3. код заполняет ячейки в произвольном порядке, указанном выше

РЕДАКТИРОВАТЬ # 1:

Эта версия Shuffle() не нуждается ArrayLists :

Public Sub Shuffle(InOut() As Variant)
    Dim i As Long, j As Long
    Dim tempF As Double, Temp As Variant

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim helper(Low To Hi) As Double
    Randomize

    For i = Low To Hi
        helper(i) = Rnd
    Next i


    j = (Hi - Low + 1) \ 2
    Do While j > 0
        For i = Low To Hi - j
          If helper(i) > helper(i + j) Then
            tempF = helper(i)
            helper(i) = helper(i + j)
            helper(i + j) = tempF
            Temp = InOut(i)
            InOut(i) = InOut(i + j)
            InOut(i + j) = Temp
          End If
        Next i
        For i = Hi - j To Low Step -1
          If helper(i) > helper(i + j) Then
            tempF = helper(i)
            helper(i) = helper(i + j)
            helper(i + j) = tempF
            Temp = InOut(i)
            InOut(i) = InOut(i + j)
            InOut(i + j) = Temp
          End If
        Next i
        j = j \ 2
    Loop
End Sub

В основной программе измените:

Call Shuffle2(arr)

на :

Call Shuffle(arr)